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