Kategoriearchive: Clarion

outlook ole control

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'}

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)

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
 

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