Program
map
end
window WINDOW('Caption'),AT(,,260,100),FONT('MS Sans Serif',8,,FONT:regular),GRAY
OLE,AT(31,20,133,78),USE(?Ole1),CREATE('outlook.application')
END
END
ItemObj cstring(20)
Code
Open(window)
display
ItemObj=?ole1{'createitem(0)'}
?Ole1{citem & '.Display'}
Kategoriearchive: Clarion
mkdir – create directory
Add to your global map:
module('clib')
MkDir(*cstring),short,raw,name('_mkdir')
end
Then in your code call it!
If you have an existing directory called c:\L1 and want to make c:\L1\L2\L3 then
newdir='c:\L1\L2'
If mkdir(NewDir) then Message('error');return.
NewDir='c:\L1\L2\L3'
If Mkdir(newDir)then Message('error');return.
Message('done')
map network drive
!global equates
NETRESOURCE GROUP
dwScope ULONG
dwType ULONG
dwDisplayType ULONG
dwUsage ULONG
lpLocalName ULONG
lpRemoteName ULONG
lpComment ULONG
lpProvider ULONG
END
CONNECT_UPDATE_PROFILE EQUATE(01h)
RESOURCETYPE_DISK EQUATE(01h)
RESOURCETYPE_PRINT EQUATE(02h)
RESOURCETYPE_ANY EQUATE(00h)
!global prototypes
MODULE('WNET API')
WNetAddConnection(*NETRESOURCE,*CSTRING,*CSTRING,ULONG),SIGNED,PASCAL,RAW,NAME('WNetAddConnection2A')
END
!local data
LOC:NetRes LIKE(NETRESOURCE)
LOC:lpPassword CSTRING(20)
LOC:lpUserName CSTRING(20)
LOC:dwFlags ULONG
LOC:lpLocalName CSTRING(10)
LOC:lpRemoteName CSTRING(260)
LOC:lpComment CSTRING(10)
LOC:lpProvider CSTRING(10)
!map network drive
CLEAR(LOC:NetRes)
LOC:NetRes.dwType = RESOURCETYPE_DISK
LOC:lpLocalName = 'F:'
LOC:lpRemoteName = '\\III-NTServer\C'
LOC:NetRes.lpLocalName = ADDRESS(LOC:lpLocalName)
LOC:NetRes.lpRemoteName = ADDRESS(LOC:lpRemoteName)
CLEAR(LOC:lpPassword)
CLEAR(LOC:lpUserName)
LOC:dwFlags = CONNECT_UPDATE_PROFILE
Erc# = WNetAddConnection(LOC:NetRes,LOC:lpPassword,LOC:lpUserName,LOC:dwFlags)
convert long to hex
LOOP
IF LongValue = 0 THEN BREAK END
StringValue = CLIP(StringValue) AND SUB('0123456789ABCDEF',LongValue%16+1, 1 )
LongValue = LongValue / 16
END
last weekday of a month
!---------------------------------------------------------
! Last Weekday of a Month
!---------------------------------------------------------
!Text Equates
SundayText Equate('Sunday')
MondayText Equate('Monday')
TuesdayText Equate('Tuesday')
WednesdayText Equate('Wednesday')
ThursdayText Equate('Thursday')
FridayText Equate('Friday')
SaturdayText Equate('Saturday')
! Numeric Equates
Sunday Equate(1)
Monday Equate(2)
Tuesday Equate(3)
Wednesday Equate(4)
Thursday Equate(5)
Friday Equate(6)
Saturday Equate(7)
LastDayOfMonth Long
AnyDate Long
AnyDate = any given Clarion standard date
LastDayOfMonth = date(month(AnyDate) + 1,1,year(AnyDate)) -1
!Execute some code depening on day of week
Execute (LastDayOfMonth % 7) + 1
Do SundayRoutine
Do MondayRoutine
Do TuesdayRoutine
Do WednesdayRoutine
Do ThursdayRoutine
Do FridayRoutine
Do SaturdayRoutine
End
! or return a value to a variable
Execute (LastDayOfMonth % 7) + 1
?DayText = SundayText
?DayText = MondayText
?DayText = TuesdayText
?DayText = WednesdayText
?DayText = ThursdayText
?DayText = FridayText
?DayText = SaturdayText
End
Clarion Equates for Level
Level:Benign EQUATE(0)
Level:User EQUATE(1)
Level:Program EQUATE(2)
Level:Fatal EQUATE(3)
Level:Cancel EQUATE(4)
Level:Notify EQUATE(5)
Install ODBC DSN
> c) we are using the Install Builder, how exactly can we make our
> installer to create the .dsn?
>
Jim Kane:
This code I wrote for someone else on the newsgroup makes a dsn and deletes it. You need to make lib files for the indicated dlls.
program
_abcdllmode_ equate(0)
_abclinkmode_ equate(1)
map
module('api')
sqlinstallererror(ushort ierror, *ulong pfErrorCode,|
*cstring szErrorMsg, ushort cbErrorMsgMax,|
*ushort pcbErrorMsg),short,pascal,raw,Name('SQLInstallerError')
!found in odbccp32.dll
configdsn(unsigned,ushort,*cstring,*cstring)|
,bool,raw,pascal,Name('ConfigDsn')
!found in odbcjt32.dll
end
end
driverstring cstring(256)
attrstring cstring(256) !attribute string to pass in configdsn
maindir cstring('c:\maindir\') !junk non-existant dir to produce an error
rv bool !return value from configdsn 0=error
i ushort !sqlinstallererror can return up to 8 error codes
szErrorstr cstring(256) !receives an error string
fErrorCode ulong !receives and errorcode
cbErrorMsg ushort !size of errorstr returned
!sql related equates for return value from SQLInstallerError
SQL_Success equate(0)
Sql_Success_with_Info equate(1)
SQL_STILL_EXECUTING equate(2)
SQL_Error equate(-1)
SQL_No_Data equate(100)
eRet short
code
if message('Create DSN or Error','CreateDSN
Demo',icon:question,'DSN|Error')=1
driverstring='Access'&'<0><0>'
else
driverstring='<0><0>'
end
attrstring='DSN=temp;DriverID=25;DBQ=' & clip(maindir) & '\dacsdata.mdb'& '<0><0>'
rv=ConfigDSN(0,1,driverstring,attrstring) !create the DSN
if ~rv then
Message('Config DSN Failed - error messages to follow.')
loop I=1 to 8
eRet=SqlInstallerError(I,fErrorcode, szErrorStr, size(szErrorStr)-1, cbErrorMsg)
if (eRet=Sql_Success or eRet=Sql_Success_With_Info) and cbErrormsg then
message(szErrorstr,'ConfigDSN Error')
else
message('End of Error Messages')
break
end
end
else
message('If you open ODBC in control panel before pressing ok, you''ll see your dsn','configdsn worked')
rv=configDsn(0,3,driverstring,attrstring)
if rv then
message('the dsn was deleted')
else
Message('deleting the dsn failed')
end
end
return
hand code print previewer
Some people have asked me to forward to them an example. I am putting the example here for all to see. I hope it can sassist in overcoming some of the reporting hassles! This is a hand coded multiple detail report, using ABC’s print previewer. Note the Module level include – do not put it at procedural level. This reports first on Customer file, then on OtherCustomer file.
MEMBER('roadshow.clw') ! This is a MEMBER
module
MAP
INCLUDE('ROADS010.INC'),ONCE !Local module prodecure declarations
END
Include('ABREPORT.INC') !********MODULE LEVEL INCLUDE**********************
HandCodedReport PROCEDURE ! Declare Procedure
LocalPreviewQueue PreviewQueue
Previewer PrintPreviewClass
Report
REPORT,AT(1000,1271,6000,7729),PRE(RPT),FONT('Arial',10,,),PREVIEW(LocalPreviewQueue),THOUS
HEADER,AT(1000,1000,6000,281)
STRING('Customer List'),AT(52,52,5906,208),USE(?String1),TRN,CENTER
END
Detail DETAIL,AT(,,,271)
STRING(@s100),AT(31,21),USE(CUS:CustomerName),TRN
END
detail2 DETAIL,AT(,,,333)
STRING(@s40),AT(73,83,2448,208),USE(Cus2:CustomerName),TRN
END
END
CODE
Relate:Customers.Open
Open(Report)
Previewer.Init(LocalPreviewQueue)
Previewer.Maximize = True
Previewer.ZoomIndex = PageWidth
Previewer.AllowUserZoom = True
Previewer.UserPercentile = 120
Previewer.SetZoomPercentile(120)
Report{Prop:Text} = 'Currently Printing Hand Coded Report'
Set(Customers)
Loop
Next(Customers)
If Error() then
Break
End
Print(RPT:Detail) !don't forget the reports' prefix when using the print verb
End
Set(OtherCustomers)
Loop
Next(OtherCustomers)
If Error() then
Break
End
Print(RPT:Detail2)
End
EndPage(Report) !do not forget this
Report{Prop:FlushPreview} = Previewer.Display()
Close(Report)
Relate:Customers.Close
get windows version – 1
prototype: api-function: GetVersionEx( *group), bool, pascal, raw, name('GetVersionExA')
procedure: GetWinVersion(), long
return: 0-error, 1-win32s, 2-win95, 3-win98, 4-nt4, 5-nt2000
code:
execute 1+ GetWinVersion()
s"= 'error in GetWinVersion'
s"= 'win32s'
s"= 'win95'
s"= 'win98'
s"= 'nt4'
s"= 'nt2000'
end
message( s")
definition:
GetWinVersion procedure
ret long, auto
tosvi group, type
dwOSVersionInfoSize ulong
dwMajorVersion ulong
dwMinorVersion ulong
dwBuildNumber ulong
dwPlatformId ulong
szCSDVersion cstring( 128)
end
osviex group, auto
osvi group( tosvi).
wServicePackMajor long
wServicePackMinor long
wSuiteMask long
wProductType byte
wReserved byte
end
code
ret= 0
clear( osviex, -1)
osviex.osvi.dwOSVersionInfoSize= size( osviex)
if not GetVersionEx( osviex)
osviex.osvi.dwOSVersionInfoSize= size( osviex.osvi)
if not GetVersionEx( osviex) then return ret.
end
execute 1+ osviex.osvi.dwPlatformId
do win32s
do win9x
do winnt
end
return( ret)
winnt routine
if osviex.osvi.dwMajorVersion <= 4
ret= 4
elsif osviex.osvi.dwMajorVersion = 5
ret= 5
end
win9x routine
if osviex.osvi.dwMajorVersion > 4 or |
( osviex.osvi.dwMajorVersion = 4 and osviex.osvi.dwMinorVersion >
0)
ret= 3
else
ret= 2
end
win32s routine
ret= 1
omit( '->')
---------------------------------------------------------------------------------------------
BOOL DisplaySystemVersion()
{
OSVERSIONINFOEX osvi;
BOOL bOsVersionInfoEx;
// Try calling GetVersionEx using the OSVERSIONINFOEX structure,
// which is supported on Windows 2000.
//
// If that fails, try using the OSVERSIONINFO structure.
ZeroMemory(&osvi, sizeof(OSVERSIONINFOEX));
osvi.dwOSVersionInfoSize = sizeof(OSVERSIONINFOEX);
if( !(bOsVersionInfoEx = GetVersionEx ((OSVERSIONINFO *) &osvi)) )
{
// If OSVERSIONINFOEX doesn't work, try OSVERSIONINFO.
osvi.dwOSVersionInfoSize = sizeof (OSVERSIONINFO);
if (! GetVersionEx ( (OSVERSIONINFO *) &osvi) )
return FALSE;
}
switch (osvi.dwPlatformId)
{
case VER_PLATFORM_WIN32_NT:
// Test for the product.
if ( osvi.dwMajorVersion <= 4 )
printf( "Microsoft Windows NT ");
if ( osvi.dwMajorVersion == 5 )
printf ("Microsoft Windows 2000 ");
// Test for workstation versus server.
if( bOsVersionInfoEx )
{
if ( osvi.wProductType == VER_NT_WORKSTATION )
printf ( "Professional " );
if ( osvi.wProductType == VER_NT_SERVER )
printf ( "Server " );
}
else
{
HKEY hKey;
char szProductType[80];
DWORD dwBufLen;
RegOpenKeyEx( HKEY_LOCAL_MACHINE,
"SYSTEM\\CurrentControlSet\\Control\\ProductOptions",
0, KEY_QUERY_VALUE, &hKey );
RegQueryValueEx( hKey, "ProductType", NULL, NULL,
(LPBYTE) szProductType, &dwBufLen);
RegCloseKey( hKey );
if ( lstrcmpi( "WINNT", szProductType) == 0 )
printf( "Workstation " );
if ( lstrcmpi( "SERVERNT", szProductType) == 0 )
printf( "Server " );
}
// Display version, service pack (if any), and build number.
printf ("version %d.%d %s (Build %d)\n",
osvi.dwMajorVersion,
osvi.dwMinorVersion,
osvi.szCSDVersion,
osvi.dwBuildNumber & 0xFFFF);
break;
case VER_PLATFORM_WIN32_WINDOWS:
if ((osvi.dwMajorVersion > 4) ||
((osvi.dwMajorVersion == 4) && (osvi.dwMinorVersion > 0)))
{
printf ("Microsoft Windows 98 ");
}
else printf ("Microsoft Windows 95 ");
break;
case VER_PLATFORM_WIN32s:
printf ("Microsoft Win32s ");
break;
}
return TRUE;
}
Hard Disk Serial Number
> I need to read hard disk serial number from application written in Clarion
> 5.0 to protect application from unauthorized copying.
Anton Novikov:
Prototypes:
GetVolumeInformationA(<*LPCSTR>,*LPSTR,DWORD,*DWORD,*DWORD,*DWORD,*LPSTR ,DWORD),BOOL,PASCAL,RAW
GetLastError (),DWORD,PASCAL,NAME('GetLastError')
Parameters:
RootPathName LPCSTR(4)
VolumeName LPSTR(15)
VolumeNameSize DWORD(128)
VolSerialNum DWORD(15) !that's what you need
MaxCompLen DWORD(15)
FileSysFlags DWORD(15)
FileSysName LPSTR(15)
FileSName DWORD(15)
Code:
IF GetVolumeInformationA(, |
VolumeName, |
VolumeNameSize, |
VolSerialNum, |
MaxCompLen, |
FileSysFlags, |
FileSysName, |
FileSName)
MESSAGE('VolumeName= ' & VolumeName & '|' & 'VolSerialNum= ' & VolSerialNum)
ELSE
MESSAGE('API Error '& GetLastError())
END