home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2.0 - Programmer's Utilities Power Pack / Delphi 2.0 Programmer's Utilities Power Pack.iso / s_to_z / tpw32_10 / tpw32.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-15  |  67.5 KB  |  2,100 lines
  1. unit TPW32;
  2. {
  3. Original message by Christian Ghisler: (in LONGNAME.PAS)
  4. --------------------------------------
  5. Functions to use long filenames}
  6. {All functions start with "W32" to distinguish them from 16 bit functions}
  7. {To call a function, use it like a normal function, with one exception:
  8.  the last parameter must be the id value for that function. Example:
  9.  longhandle:=W32FindFirstFile('c:\*.*',finddata,id_W32FindFirstFile);}
  10.  
  11. {VERY IMPORTANT: All these functions work fine on Windows 95, but NOT all work on
  12.  Windows NT:
  13.  - W32SetCurrentDirectory returns true, but does NOT actually change the current directory
  14.  
  15.  all other functions seem to work fine, but test your application on NT before saying that
  16.  it runs fine!
  17.  
  18.  
  19. New message by Dr A Olowofoyeku:
  20. -------------------------------
  21.  
  22. FILE: TPW32.PAS
  23.  
  24. Purpose:
  25. This unit implements some functions in the Win32 API, which can be called
  26. from BPW or Delphi programs. The functions implemented here are few and
  27. mainly serve my own purposes. I have added some functions of my own, for
  28. my own programming needs. Some of them involve big kludges, but they seem
  29. to work. Your mileage may vary.
  30.  
  31. This has been tested only under BPW - but it should work with Delphi
  32. - you may need to replace "WinDos.xxx" with "SysUtils.xxx"
  33.  
  34. HISTORY-
  35. 1. Original translation by Christian Ghisler
  36. 2. More Win32 API functions added by Dr A Olowofoyeku
  37. 3. Some general functions written by Dr A Olowofoyeku
  38. 4. Some functions supplied courtesy of Claus Ziegler
  39. }
  40.  
  41. interface
  42. {F+,G+,I-}
  43.  
  44. uses
  45. W32Types;
  46.  
  47. {/////// exported variables /////}
  48. Var
  49. IsWindowsNT,    {Are we running Windows NT?}
  50. IsWindows95     {Are we running Windows 95?}
  51. :Boolean;
  52. {/////////////////////////////////////////////////////////}
  53. {/////////////////////////////////////////////////////////}
  54. {/////////// Dr Olowofoyeku's own functions //////////////}
  55. {/////////////////////////////////////////////////////////}
  56. {/////////////////////////////////////////////////////////}
  57. Function IsWin32OS:Boolean;
  58. {Return whether we can use 32-bit functions or not; if ANY of the
  59. Win32 API functions fails to initialise correctly, this function
  60. will return false}
  61.  
  62. Function  SetWin32OSValue(Const Enable:Boolean):Boolean;
  63. {change Win32 support on the fly; returns the old value of Use32Bit}
  64.  
  65. Function Stupcase(Const s:String):String;
  66. {convert a string to uppercase}
  67.  
  68. Function W32Exist(Var FName:String):Boolean;
  69. {does a file exist? if so, return its full path}
  70.  
  71. Function W32IsDirectory(Var DirName:String):Boolean;
  72. {does a directory exist? if so, return its full path}
  73.  
  74. Function W32Rename(TheOld, TheNew:String):longbool;
  75. {rename a file; with longname support}
  76.  
  77. Function W32Move(TheOld, TheNew:String):longbool;
  78. {move a file, by renaming it; if TheNew exists,
  79. it will try to delete it and then do a rename}
  80.  
  81. Function StripQuotes(s:String):String;
  82. {remove quotation marks from a string and return the result}
  83.  
  84. Function StripChar(s:string;ch:char):string;
  85. {remove all occurences of "ch" from "s", and return the result}
  86.  
  87. Function W32WinExec(p:Pchar;mode:longint):longint;
  88. {winexec for win32}
  89.  
  90. Function ThisDrive:String;
  91. {Return the current drive: e.g., "C:", "D:"}
  92.  
  93. function isUNC(Const s:string):boolean;
  94. {is a drive a UNC name?}
  95.  
  96. Function IsUNCP(aName:pChar):Boolean;
  97. {is a drive a UNC name? - use PChar instead of string}
  98.  
  99. Function W32FullPathName(s:string):String;
  100. {return full path for a file you know to exist}
  101.  
  102. Function AddBackSlash(s:String):String;
  103. {add a back slash to a path name}
  104.  
  105. Function AddNull(S:String):String;
  106. {add a null character (#0) to a string}
  107.  
  108. Function Str2PChar(Var S:String):PChar;
  109. {convert a string to a pchar}
  110.  
  111. Function IsWinNT : Boolean;
  112. {Are we running Windows NT?}
  113.  
  114. Function W32MkDir(s:String): longint;
  115. {make a directory - with long filename support}
  116.  
  117. Function W32Chdir(s:String): longint;
  118. {change to a directory - with long filename support}
  119.  
  120. Function W32RmDir(s:String): longint;
  121. {remove a directory - with long filename support}
  122.  
  123. Function W32ShowDir:String;
  124. {get the long name of the current directory}
  125.  
  126. Function GetShortFName(FName:String):String;
  127. {get the short name of a long filename}
  128.  
  129. Function GetLongFName(Const FName:String):String;
  130. {get the long name of a short filename}
  131.  
  132. Function GetFullFName(Const FName:String):String;
  133. {get a file's full path name}
  134.  
  135. Function PathNameOnly(s:String):String;
  136. {return the path only out of a filename}
  137.  
  138. Function FileNameOnly(s:String):String;
  139. {strip the path out of a filename}
  140.  
  141. Procedure ConvertT32SearchRec(Var lr:WIN32_FIND_DATA;Var sR:T32SearchRec);
  142. {convert a Win32_Find_Data record to a T32SearchRec record}
  143.  
  144. Function W32FindFirst(p:pchar;Const Attrs:longint;Var sR:T32SearchRec):longint;
  145. {find a file - with long filename}
  146.  
  147. Function W32FindNext(Var sR:T32SearchRec):longbool;
  148. {- ditto -}
  149.  
  150. Function LocateFiles(fSpec:pchar;Const Attrs:Longint;Var sR:T32SearchRec; CallBack:T32FileProc):Boolean;
  151. {shell function to get filenames matching a spec}
  152.  
  153. Function GetEnv(lpName:String):String;
  154. {get an environment variable}
  155.  
  156. Function SetEnv(lpName, lpValue:String):Longbool;
  157. {set an environment variable}
  158.  
  159. Function W32Rewrite(Var fname:string):longint;
  160. {create a new file - with long filename support}
  161.  
  162. Function W32Reset(fname:string):longint;
  163. { open a file - with long name support}
  164.  
  165. Function W32Close(handle:longint):longbool;
  166. {close a file by its handle}
  167.  
  168. Function ExistFile(aName:PChar):Boolean;
  169. {does the file exist?}
  170.  
  171. Function ExistDirectory(aName:PChar):Boolean;
  172. {does the directory exist?}
  173.  
  174. Function ExistFileOrDirectory(aName:PChar):Boolean;
  175. {does a file or directory exist?}
  176. {/////////////////////////////////////////////////////////}
  177. {/////////////////////////////////////////////////////////}
  178. {/////////////////////////////////////////////////////////}
  179. {/////////// Win32 API functions /////////////////////////}
  180. {/////////////////////////////////////////////////////////}
  181. {/////////////////////////////////////////////////////////}
  182. {/////////////////////////////////////////////////////////}
  183. {/////////////////////////////////////////////////////////}
  184. { //// Processes ////}
  185.   Function SetEnvironmentVariable(lpName, lpValue:pchar):Longbool;
  186.  
  187.   Function GetEnvironmentVariable(lpName, buffer:pchar;bufsize:longint):Longint;
  188.  
  189.   Function GlobalMemoryStatus(Var ms:MemoryStatus):longint;
  190.   {
  191.   Function GetFreeSpace(Flags:Longint):longint;
  192.   }
  193.  
  194.   Function GetCurrentProcess:Longint;
  195.  
  196.   Function GetCurrentProcessId:Longint;
  197.  
  198.   Function GetCurrentThread:Longint;
  199.  
  200.   Function WaitForSingleObject(hObject,dwTimeout:longint):longint;
  201.  
  202.   Function CreateProcess(lpszImageName,lpszCommandLine:pchar;
  203.                          lpsaProcess,lpsaThread:pointer;
  204.                          fInheritHandles:longbool;
  205.                          fdwCreate:longint;
  206.                          lpvEnvironment:pointer;
  207.                          lpszCurDir:pchar;
  208.                          var lpsiStartInfo:tstartupinfo;
  209.                          var lppiProcInfo:PROCESS_INFORMATION):longbool;
  210.  
  211.   Function ShellExecute(hwnd:longint;
  212.            lpszOp,lpszFile,lpszParams,lpszDir:pchar;
  213.            wShowCmd:longint):longint;
  214.  
  215. { //// Files ////}
  216.   Function FindFirstFile(lpszSearchFile:pchar;var lpffd:WIN32_FIND_DATA):longint;
  217.  
  218.   Function FindNextFile(hFindFile:longint;var lpffd:WIN32_FIND_DATA):longbool;
  219.  
  220.   Function FindClose(hFindFile:longint):Longbool;
  221.  
  222.   Function CloseHandle(hfile:longint):longbool;
  223.  
  224.   Function CreateFile(lpszName:pchar;fdwAccess,fdwShareMode:longint;lpsa:pointer;
  225.                          fdwCreate,fdwAttrsAndFlags,hTemplateFile:longint):longint;
  226.  
  227.   Function CopyFile(source, dest:pchar;SkipExisting:longbool):longbool;
  228.  
  229.   Function MoveFile(lpszExisting,lpszNew:pchar):longbool;
  230.  
  231.   Function Deletefile(path:pchar):longbool;
  232.  
  233.   Function ReadFile(hFile:longint;var lpBuffer;nNumberOfBytesToRead:longint;
  234.     var lpNumberOfBytesRead:longint;lpOverlapped:pointer):longbool;
  235.  
  236.   Function WriteFile(hFile:longint;var lpBuffer;nNumberOfBytesToWrite:longint;
  237.     var lpNumberOfBytesWritten:longint;lpOverlapped:pointer):longbool;
  238.  
  239.   Function FlushFileBuffers(hfile:longint):longbool;
  240.  
  241.   Function SetFileAttributes(path:pchar;attr:longint):longbool;
  242.  
  243.   Function GetFileAttributes(path:pchar):longint;
  244.  
  245.   Function SetFilePointer(hFile,lDistanceToMove:longint;lpDistanceToMoveHigh:pointer;
  246.             dwMoveMethod:longint):longint;
  247.  
  248.   Function SetFileTime(hFile:longint;lpftCreation,lpftLastAccess,lpftLastWrite:pfiletime):longbool;
  249.  
  250.   Function GetFileTime(hFile:longint;lpftCreation,lpftLastAccess,lpftLastWrite:pfiletime):longbool;
  251.  
  252.   Function FileTimeToSystemTime(var lpft:tFILETIME;var lpst:tsystemtime):longbool;
  253.  
  254.   Function FileTimeToLocalFileTime(var lpft,lpftlocal:tFILETIME):longbool;
  255.  
  256.   Function SystemTimeToFileTime(var lpst:tsystemtime;var lpft:tFILETIME):longbool;
  257.  
  258.   Function LocalFileTimeToFileTime(var lpftlocal,lpft:tFILETIME):longbool;
  259.  
  260. {//// Directories ///}
  261.   Function GetCurrentDirectory(cchCurDir:longint;lpszCurDir:pchar):longint;
  262.  
  263.   Function SetCurrentDirectory(lpszCurDir:pchar):longbool;
  264.  
  265.   Function GetLastError:longint;
  266.  
  267.   Function CreateDirectory(path:pchar;security:pointer):longbool;
  268.  
  269.   Function RemoveDirectory(path:pchar):longbool;
  270.  
  271. {///// my own ////}
  272. Function GetDriveType(path:pchar): byte;
  273.  
  274. Function GetFileSize(handle:longint;var hBit:longint):DWord;
  275.  
  276. Function GetLogicalDriveStrings (bufsize:longint;buffer:pchar):longint;
  277.  
  278. Function GetTempPath(bufsize:longint;buffer:pchar):longint;
  279.  
  280. Function SearchPath(spath,fname,fExt:pchar;bufsize:longint;
  281.               buffer,justfname:pchar):longint;
  282. {
  283. Function GetFullPathName
  284. (fname:pchar;bufsize:longint;buffer:Pchar;justfname:pchar):longint;
  285. }
  286. Function getFullPathName(FName:pChar;BufSize:LongInt;Buffer:pChar):Longint;
  287.  
  288. Function GetDC(ahwnd:longint):longint;
  289.  
  290. Function ReleaseDC(ahwnd,ahdc:Longint):longint;
  291.  
  292. Function PolyBezier(ahdc:longint;var points:tagPoint;count:Longint):Longint;
  293.  
  294. Function GetDesktopWindow:longint;
  295.  
  296. Function CreatePen(style,w,c:Longint):Longint;
  297.  
  298. Function SelectObject(ahdc,ahpen:longint):Longint;
  299.  
  300. Function DeleteObject(ahpen:Longint):Longint;
  301.  
  302. Function GetShortNameP(Fname:pChar):pChar;
  303.  
  304. Function GetShortPathName(Ind,ud:pChar;UdSize:LongInt):Longint;
  305.  
  306. Function GetExitCodeProcess(hProcess:LongInt;    {The process to test}
  307.                              Var ExitCode:LongInt)  {The returned code}
  308.                              :LongBool;
  309.  
  310. Function FindExecutable(fname,dir,aResult:Pchar):longint;
  311. {/////////////////////////////////////////////////////////}
  312. {file dialogs - doesn't work!!!!}
  313. Function GetOpenFileName(Var LpOfn:T32OpenFilename):LongBool;
  314. {/////////////////////////////////////////////////////////}
  315. {/////////////////////////////////////////////////////////}
  316. {///////////////////////////////////////////////////////////////}
  317. { Hooks }
  318. Function CallNextHookEx(hhk, nCode, wParam, lParam:longint):LResult;
  319. Function UnhookWindowsHookEx(hhk:HHook):Longbool;
  320. Function SetWindowsHookEx(idHook:longint; hkprc:T32HookProc; hMod, dwThreadID:longint):HHook;
  321. {///////////////////////////////////////////////////////////////}
  322. {///////////////////////////////////////////////////////////////}
  323. {///////////////////////////////////////////////////////////////}
  324. {///////////////////////////////////////////////////////////////}
  325.  
  326. implementation
  327. uses
  328. call32nt,WinProcs,WinDos,{$ifdef ver80} sysutils {$else}Strings{$endif};
  329.  
  330. Var
  331. Use32Bit:Boolean;
  332. {True if we are using either NT or Win95, and ALL our 32-bit functions
  333. initialised okay}
  334. {/////////////////////////////////////////////////////////}
  335. {/////////////////////////////////////////////////////////}
  336. {//////// procedural variables for 32-bit functions ///////}
  337. {/////////////////////////////////////////////////////////}
  338. var
  339.  
  340.   W32GetOpenFileName:Function(Var LpOfn:T32OpenFilename;id:longint):LongBool;
  341.   Id_W32GetOpenFileName:Longint; {doesn't work!}
  342.  
  343.   id_W32SetEnvironmentVariable:longint;
  344.   W32SetEnvironmentVariable:Function(lpName, lpValue:pchar;id:longint):Longbool;
  345.  
  346.   id_W32GetEnvironmentVariable:longint;
  347.   W32GetEnvironmentVariable:Function (lpName, buffer:pchar;bufsize, id:longint):Longint;
  348.  
  349.   W32FindFirstFile:
  350.   function(lpszSearchFile:pchar;var lpffd:WIN32_FIND_DATA;id:longint):longint;
  351.  
  352.   W32FindNextFile:
  353.   function(hFindFile:longint;var lpffd:WIN32_FIND_DATA;id:longint):longbool;
  354.  
  355.   W32FindClose:
  356.   function(hFindFile:longint;id:longint):Longbool;
  357.  
  358.   W32FileTimeToSystemTime:function(var lpft:tFILETIME;var lpst:tsystemtime;id:longint):longbool;
  359.  
  360.   W32FileTimeToLocalFileTime:function(var lpft,lpftlocal:tFILETIME;id:longint):longbool;
  361.  
  362.   W32SystemTimeToFileTime:function(var lpst:tsystemtime;var lpft:tFILETIME;id:longint):longbool;
  363.   W32LocalFileTimeToFileTime:function(var lpftlocal,lpft:tFILETIME;id:longint):longbool;
  364.   W32GetCurrentDirectory:function(cchCurDir:longint;lpszCurDir:pchar;id:longint):longint;
  365.   W32SetCurrentDirectory:function(lpszCurDir:pchar;id:longint):longbool;
  366.   W32CreateFile:function(lpszName:pchar;fdwAccess,fdwShareMode:longint;lpsa:pointer;
  367.                          fdwCreate,fdwAttrsAndFlags,hTemplateFile,id:longint):longint;
  368.   W32MoveFile:function(lpszExisting,lpszNew:pchar;id:longint):longbool;
  369.   W32GetLastError:function(id:longint):longint;
  370.   W32CreateDirectory:function(path:pchar;security:pointer;id:longint):longbool;
  371.   W32RemoveDirectory:function(path:pchar;id:longint):longbool;
  372.   W32SetFileAttributes:function(path:pchar;attr,id:longint):longbool;
  373.   W32GetFileAttributes:function(path:pchar;id:longint):longint;
  374.   W32Deletefile:function(path:pchar;id:longint):longbool;
  375.   W32SetFilePointer:function(hFile,lDistanceToMove:longint;lpDistanceToMoveHigh:pointer;
  376.             dwMoveMethod,id:longint):longint;
  377.   W32SetFileTime:function(hFile:longint;lpftCreation,lpftLastAccess,lpftLastWrite:pfiletime;
  378.             id:longint):longbool;
  379.   W32GetFileTime:function(hFile:longint;lpftCreation,lpftLastAccess,lpftLastWrite:pfiletime;
  380.             id:longint):longbool;
  381.  
  382.   W32ReadFile:function(hFile:longint;var lpBuffer;nNumberOfBytesToRead:longint;
  383.     var lpNumberOfBytesRead:longint;lpOverlapped:pointer;id:longint):longbool;
  384.   W32WriteFile:function(hFile:longint;var lpBuffer;nNumberOfBytesToWrite:longint;
  385.     var lpNumberOfBytesWritten:longint;lpOverlapped:pointer;id:longint):longbool;
  386.   W32FlushFileBuffers:function(hfile,id:longint):longbool;
  387.  
  388.   W32ShellExecute:
  389.   function(hwnd:longint;
  390.            lpszOp,lpszFile,lpszParams,lpszDir:pchar;
  391.            wShowCmd,id:longint):longint;
  392.  
  393.   W32CloseHandle:function(hfile,id:longint):longbool;
  394.  
  395.   W32WaitForSingleObject:function(hObject,dwTimeout,id:longint):longint;
  396.  
  397.   W32CreateProcess:
  398.   function(lpszImageName,lpszCommandLine:pchar;
  399.           lpsaProcess,lpsaThread:pointer;
  400.           fInheritHandles:longbool;
  401.           fdwCreate:longint;
  402.           lpvEnvironment:pointer;
  403.           lpszCurDir:pchar;
  404.           var lpsiStartInfo:tstartupinfo;
  405.           var lppiProcInfo:PROCESS_INFORMATION;
  406.           id:longint):longbool;
  407.  
  408.   W32GetCurrentThread:function(id:longint):longint;
  409.  
  410.   W32GetCurrentProcess:function(id:longint):longint;
  411.  
  412.   W32GetCurrentProcessId:function(id:longint):longint;
  413. {/////////////////////////////////////////////////////////}
  414.  
  415. Var
  416. W32GetDriveType:Function(path:pchar; id:longint): byte;
  417.  
  418. W32CopyFile:Function(source, dest:pchar;SkipExisting:longbool;id:longint):longbool;
  419.  
  420. W32GetFileSize:Function(handle:longint;var hBit:longint;id:longint):DWord;
  421.  
  422. W32GetLogicalDriveStrings:
  423. Function(bufsize:longint;buffer:pchar;id:longint):longint;
  424.  
  425. W32GetTempPath:Function(bufsize:longint;buffer:pchar;id:longint):longint;
  426.  
  427. W32SearchPath:
  428. Function(searchpath,fname,fExt:pchar;bufsize:longint;buffer,justfname:pchar;id:longint):longint;
  429.  
  430.  
  431. W32GetFullPathName:
  432. Function(fname:pchar;bufsize:longint;buffer,justfname:pchar;id:longint):longint;
  433.  
  434.  
  435. W32GetDC:function(hwnd,id:longint):longint;
  436. W32ReleaseDC:function(hwnd,hdc,id:Longint):longint;
  437. W32PolyBezier:function(hdc:longint;var points:tagPoint;count,id:Longint):Longint;
  438. W32GetDesktopWindow:function(id:Longint):longint;
  439. W32CreatePen:function(style,w,c,id:Longint):Longint;
  440. W32SelectObject:function(hdc,hpen,id:longint):Longint;
  441. W32DeleteObject:function(hpen,id:Longint):Longint;
  442.  
  443. W32GetShortPathName:Function(Ind,ud:pChar;UdSize,ID:LongInt):LongInt;
  444. W32GetExitCodeProcess:Function(hProcess:LongInt;    {The process to test}
  445.                                  Var ExitCode:LongInt;  {The returned code}
  446.                                  ID:LongInt):LongBool;
  447.  
  448. W32FindExecutable:Function (fname,dir,aResult:Pchar;id:longint):longint;
  449. W32GlobalMemoryStatus:function(Var ms:MemoryStatus;id:longint):longint;
  450.  
  451. {/////////////////////////////////////////////////////////}
  452. {////////////longint variables for the procedural ones ///}
  453. {/////////////////////////////////////////////////////////}
  454. var
  455.   {OldAttr,}
  456.   id_W32FindExecutable,
  457.   id_W32GetExitCodeProcess  : Longint;
  458.   id_W32GetShortPathName    : LongInt;
  459.  
  460.   id_W32FindFirstFile,
  461.   id_W32FindNextFile,
  462.   id_W32FindClose,
  463.   id_W32FileTimeToSystemTime,
  464.   id_W32FileTimeToLocalFileTime,
  465.   id_W32SystemTimeToFileTime,
  466.   id_W32LocalFileTimeToFileTime,
  467.   id_W32GetCurrentDirectory,
  468.   id_W32SetCurrentDirectory,
  469.   id_W32CreateFile,
  470.   id_W32MoveFile,
  471.   id_W32GetLastError,
  472.   id_W32CreateDirectory,
  473.   id_W32RemoveDirectory,
  474.   id_W32SetFileAttributes,
  475.   id_W32GetFileAttributes,
  476.   id_W32Deletefile,
  477.   id_W32SetFilePointer,
  478.   id_W32setFileTime,
  479.   id_W32GetFileTime,
  480.   id_W32CloseHandle,
  481.   id_W32ReadFile,
  482.   id_W32WriteFile,
  483.   id_W32FlushFileBuffers,
  484.   id_W32ShellExecute,
  485.   id_W32WaitForSingleObject,
  486.   id_W32CreateProcess:longint;
  487.   id_W32GetCurrentProcessId:Longint;
  488.   id_W32GetCurrentProcess:Longint;
  489.   id_W32GetCurrentThread:Longint;
  490.  
  491.   id_W32GlobalMemoryStatus,
  492.   id_W32GetFreeSpace,
  493.   id_W32GetFileSize,
  494.   id_W32CopyFile,
  495.   id_W32GetDriveType,
  496.   id_W32GetLogicalDriveStrings,
  497.   id_W32GetTempPath,
  498.   id_W32SearchPath,
  499.   id_W32GetFullPathName:longint;
  500.  
  501.   id_W32GetDesktopWindow,
  502.   id_W32GetDC,
  503.   id_W32ReleaseDC,
  504.   id_W32PolyBezier,
  505.   id_W32CreatePen,
  506.   id_W32SelectObject,
  507.   id_W32DeleteObject:longint;
  508.  
  509.  
  510. {/////////////////////////////////////////////////////////}
  511. {/////////////////////////////////////////////////////////}
  512. Function ThisDrive:String;
  513. {Returns the current drive: e.g., "C:", "D:"}
  514. var
  515. s:string;
  516. Begin
  517.    GetDir(0, s);
  518.    ThisDrive:=Copy(s,1,2);
  519. End;
  520. {/////////////////////////////////////////////////////////}
  521.  
  522. {/////////////////////////////////////////////////////////}
  523. Procedure ConvertT32SearchRec(Var lr:WIN32_FIND_DATA;Var sR:T32SearchRec);
  524. {Converts a WIN32_FIND_DATA record to a T32SearchRec
  525. record - used in my W32FindFirst and W32FindNext functions}
  526. Var
  527.   localtime:tFiletime;
  528.   tdt:tsystemtime;
  529.  
  530. Begin
  531.       With sR do begin
  532.         FileTimeToLocalFileTime(lr.ftLastWriteTime,localtime);
  533.         FileTimeToSystemTime(localtime,tdt);
  534.         StrCopy(lName, lr.cFileName);
  535.         StrCopy(Name, lr.cAlternateFileName);
  536.         if Strlen(Name)=0 then StrCopy(Name,lName);
  537.  
  538.         With lDateTime do begin
  539.             Year := Tdt.Year;
  540.             Month:= Tdt.Month;
  541.             Day  := Tdt.Day;
  542.             Hour := Tdt.Hour;
  543.             Min  := Tdt.Min;
  544.             Sec  := Tdt.Sec;
  545.         end;
  546.         WinDos.PackTime(lDateTime, sR.Time);
  547.         Size := lr.nFileSizeLow;
  548.         Attr := lr.dwFileAttributes;
  549.       end;
  550. End;
  551. {/////////////////////////////////////////////////////////}
  552. Function AttributesMatch(Const TheAttr, ToMatch:longint):longbool;
  553. {Does the file attribute "ToMatch" match the attribute masks
  554. in "TheAttr"? - this is used to match the attributes passed to
  555. W32FindFirst()}
  556. begin
  557.    AttributesMatch:=false;
  558.    If (Tomatch=faAnyFile)
  559.    or ((TheAttr=0) and (ToMatch and faArchive<>0)){match 0 with archive}
  560.    or (TheAttr and ToMatch <>0)
  561.    then AttributesMatch:=true;
  562. end;
  563. {/////////////////////////////////////////////////////////}
  564. {/////////////////////////////////////////////////////////}
  565. Function FindLoop(Var sR:T32SearchRec):longbool;
  566. {loop through files until one that matches the
  567. attributes is found - this is used by W32FindFirst()
  568. and W32FindNext()
  569. }
  570. Var
  571. ismatch,ok:longbool;
  572. lr:WIN32_FIND_DATA;
  573.  
  574. Begin
  575.     FindLoop:=False;
  576.     ismatch := false;
  577.     While not ismatch do
  578.     begin
  579.       {no file found}
  580.       ok := FindNextFile(sR.hHandle, lr);
  581.       if not ok then begin
  582.          FindLoop:=False;
  583.          DosError:=2;
  584.          exit;
  585.       end;
  586.       {attributes match}
  587.       if  AttributesMatch(lr.dwFileAttributes, sR.hAttrib) then begin
  588.           DosError:=0;
  589.           ConvertT32SearchRec(lr, sR);
  590.           FindLoop:=true;
  591.           exit;
  592.       end;
  593.    end; {while not ismatch}
  594. end;
  595. {/////////////////////////////////////////////////////////}
  596. Procedure TSearchRecToT32(var sR:T32SearchRec);
  597. {convert a TSearchRec to a T32SearchRec}
  598. begin
  599.       With sR do begin
  600.         StrCopy(sR.lName, sR.tSs.Name);
  601.         StrCopy(sR.Name, sR.tSs.Name);
  602.         sR.Time := sR.tSs.Time;
  603.         sR.Size := sR.tSs.Size;
  604.         sR.Attr := sR.tSs.Attr;
  605.         WinDos.UnPackTime(sR.tSs.Time,sR.lDateTime);
  606.       end;
  607. end;
  608. {/////////////////////////////////////////////////////////}
  609. Function W32FindFirst(p:pchar;Const Attrs:longint;Var sR:T32SearchRec):longint;
  610. {find a file matching filespecs in "p", and attributes in "attrs"
  611.  Return the result in a T32SearchRec record
  612.  
  613.  This can be used just like the FindFirst procedure in the WinDOS unit,
  614.  even when not using 32-bit functionality
  615.  
  616.  e.g.,
  617.  Var
  618.  p:array[0..79] of char;
  619.  sR:T32SearchRec;
  620.  
  621.  begin
  622.     Strpcopy(p, 'C:\WIN95\*.*');
  623.     W32FindFirst(p, faAnyFile, sR);
  624.     While DosError=0 do begin
  625.        Writeln('Short Name=',sr.Name);
  626.        Writeln('Long  Name=',sr.lName);
  627.        W32FindNext(sR);
  628.     end;
  629.  end.
  630.  
  631.  }
  632. Var
  633. handle:longint;
  634. lr:WIN32_FIND_DATA;
  635.  
  636. Var
  637. s1:string;
  638. b:longbool;
  639.  
  640. Begin
  641.  
  642.    If Not Use32Bit then {if we are using 16-bits only - call WinDOS.FindFirst}
  643.    begin
  644.       FindFirst(p, Word(Attrs), sR.tSs);
  645.       If DosError=0 then
  646.       With sR do begin
  647.         StrCopy(sR.lName, sR.tSs.Name);
  648.         StrCopy(sR.Name, sR.tSs.Name);
  649.         sR.Time := sR.tSs.Time;
  650.         sR.Size := sR.tSs.Size;
  651.         sR.Attr := sR.tSs.Attr;
  652.         WinDos.UnPackTime(sR.tSs.Time,sR.lDateTime);
  653.       end;
  654.       W32FindFirst:=DosError;
  655.       exit;
  656.    end;
  657.    {}
  658.    FillChar(sR, sizeof(sR), #0);
  659.    s1:=StripChar(Strpas(p), '"');
  660.  
  661.    handle:=FindFirstFile(Str2PChar(s1), lr);
  662.    if handle<>-1 then{success}
  663.    begin
  664.       sR.hHandle := Handle; {save handle}
  665.       sR.hAttrib := Attrs;  {save attributes}
  666.  
  667.       if  AttributesMatch(lr.dwFileAttributes, Attrs) then
  668.       begin
  669.          ConvertT32SearchRec(lr, sR);
  670.          DosError:=0;
  671.       end
  672.       else
  673.       begin
  674.          {else; attributes don't match}
  675.          b := findloop(sr);
  676.          if b then  {match found}
  677.          begin
  678.             DosError := 0;
  679.          end {if b} else
  680.          begin
  681.             DosError:=2;
  682.             FindClose(Handle);
  683.             Handle := -1;
  684.          end; {no match found}
  685.        end; {attrs and oldattr<>0}
  686.    end {handle<>-1}
  687.    else begin
  688.      DosError:=2;
  689.    end;
  690.    W32FindFirst:=handle;
  691. End;
  692. {/////////////////////////////////////////////////////////}
  693. Function W32FindNext(Var sR:T32SearchRec):longbool;
  694. {find the next file - after a call to W32FindFirst}
  695. Var
  696. b,ok:longbool;
  697. lr:WIN32_FIND_DATA;
  698. handle, Attr:Longint;
  699.  
  700. Begin
  701.  
  702.    If Not Use32Bit then begin {if we are using 16-bits only - call WinDOS.FindNext}
  703.       FindNext(sR.Tss);
  704.       If DosError=0 then
  705.       With sR do begin
  706.         StrCopy(sR.lName, sR.tSs.Name);
  707.         StrCopy(sR.Name, sR.tSs.Name);
  708.         sR.Time := sR.tSs.Time;
  709.         sR.Size := sR.tSs.Size;
  710.         sR.Attr := sR.tSs.Attr;
  711.         WinDos.UnPackTime(sR.tSs.Time,sR.lDateTime);
  712.       end;
  713.       W32FindNext:=DosError=0;
  714.       exit;
  715.    end;
  716.  
  717.     W32FindNext:=false;
  718.     handle := sR.hHandle;
  719.     Attr   := sR.hAttrib;
  720.  
  721.     ok := FindNextFile(Handle, lr);
  722.     If not ok then begin
  723.        DosError:=2;        {no match; return not found code}
  724.        FindClose(Handle);  {dispose of the file handle}
  725.        exit;
  726.     end;
  727.  
  728.     if  AttributesMatch(lr.dwFileAttributes, Attr) then begin
  729.        ConvertT32SearchRec(lr, sR);
  730.        DosError:=0;
  731.        W32FindNext:=true;
  732.        exit;
  733.     end;
  734.  
  735.     {attrs don't match - search on}
  736.     b := findloop(sr);
  737.     if b then  {match found}
  738.     begin
  739.       DosError := 0;
  740.       W32FindNext:=true;
  741.       exit;
  742.     end {if b} else
  743.     begin
  744.       DosError:=2;
  745.       FindClose(Handle);
  746.     end; {no match found}
  747. End;
  748. {/////////////////////////////////////////////////////////}
  749. Function LocateFiles(fSpec:pchar;Const Attrs:Longint;Var sR:T32SearchRec;
  750. CallBack:T32FileProc):Boolean;
  751. { sample shell function for searching for files;
  752.   fills the T32SearchRec structure;
  753.   Calls the T32FileProc function if <> Nil
  754. }
  755. Var
  756. handle:longint;
  757.  
  758. Begin
  759.   LocateFiles:=False;
  760.   If Not Use32Bit then Exit;
  761.   handle:=W32FindFirst(fSpec, faAnyFile, sR);
  762.   While DosError=0 do
  763.   begin
  764.     if @CallBack<>Nil then CallBack(sR);
  765.     W32FindNext(sR);
  766.   end;
  767. End;
  768.  
  769. {/////////////////////////////////////////////////////////}
  770. Function SetEnvironmentVariable(lpName, lpValue:pchar):Longbool;
  771. Begin
  772.    SetEnvironmentVariable :=
  773.    W32SetEnvironmentVariable(lpName, lpValue,
  774.    id_W32SetEnvironmentVariable);
  775. End;
  776.  
  777. {/////////////////////////////////////////////////////////}
  778. Function GetEnvironmentVariable(lpName, buffer:pchar;bufsize:longint):Longint;
  779. Begin
  780.    GetEnvironmentVariable :=
  781.    W32GetEnvironmentVariable(lpName, buffer,bufsize,
  782.    id_W32GetEnvironmentVariable);
  783. End;
  784. {/////////////////////////////////////////////////////////}
  785. Function SetEnv(lpName, lpValue:String):Longbool;
  786. Begin
  787.   SetEnv := SetEnvironmentVariable(Str2PChar(lpname), Str2PChar(lpvalue));
  788. End;
  789. {/////////////////////////////////////////////////////////}
  790. Function GetEnv(lpName:String):String;
  791. Var
  792. p:pchar;
  793. Begin
  794.    GetEnv:='';
  795.    if lpName='' then exit;
  796.  
  797.    If not Use32Bit then begin
  798.       p := Windos.GetEnvVar(Str2Pchar(lpName));
  799.       if p <> Nil then GetEnv := StrPas(p);
  800.       exit;
  801.    end;
  802.  
  803.    Getmem(p,262);
  804.    If GetEnvironmentVariable(Str2Pchar(lpName), p, 260)>0
  805.    then GetEnv:=Strpas(p);
  806.    Freemem(p, 262);
  807. End;
  808. {/////////////////////////////////////////////////////////}
  809. Function CloseHandle(hfile:longint):longbool;
  810. Begin
  811.      CloseHandle := W32CloseHandle(hFile, id_W32CloseHandle);
  812. End;
  813.  
  814. {/////////////////////////////////////////////////////////}
  815. Function WaitForSingleObject(hObject,dwTimeout:longint):longint;
  816. Begin
  817.       WaitForSingleObject := W32WaitForSingleObject(hObject, dwTimeOut,
  818.       id_W32WaitForSingleObject);
  819. End;
  820.  
  821. {/////////////////////////////////////////////////////////}
  822.   Function CreateProcess(lpszImageName,lpszCommandLine:pchar;
  823.           lpsaProcess,lpsaThread:pointer;
  824.           fInheritHandles:longbool;
  825.           fdwCreate:longint;
  826.           lpvEnvironment:pointer;
  827.           lpszCurDir:pchar;
  828.           var lpsiStartInfo:tstartupinfo;
  829.           var lppiProcInfo:PROCESS_INFORMATION):longbool;
  830.   Begin
  831.           CreateProcess := W32CreateProcess(
  832.           lpszImageName,
  833.           lpszCommandLine,
  834.           lpsaProcess,
  835.           lpsaThread,
  836.           fInheritHandles,
  837.           fdwCreate,
  838.           lpvEnvironment,
  839.           lpszCurDir,
  840.           lpsiStartInfo,
  841.           lppiProcInfo,
  842.           id_W32CreateProcess);
  843.   End;
  844. {/////////////////////////////////////////////////////////}
  845. {/////////////////////////////////////////////////////////}
  846.   Function FindFirstFile(lpszSearchFile:pchar;var lpffd:WIN32_FIND_DATA):longint;
  847.   Begin
  848.      FindFirstFile := W32FindFirstFile
  849.      (lpszSearchFile, lpffd, id_W32FindFirstFile);
  850.   End;
  851. {/////////////////////////////////////////////////////////}
  852.   Function FindNextFile(hFindFile:longint;var lpffd:WIN32_FIND_DATA):longbool;
  853.   Begin
  854.      FindNextFile := W32FindNextFile(hFindFile, lpffd, id_W32FindNextFile);
  855.   End;
  856. {/////////////////////////////////////////////////////////}
  857.   Function FindClose(hFindFile:longint):Longbool;
  858.   Begin
  859.     FindClose := W32FindClose(hFindFile, id_W32FindClose);
  860.   End;
  861. {/////////////////////////////////////////////////////////}
  862.   Function GetCurrentProcess:Longint;
  863.   Begin
  864.       GetCurrentProcess := W32GetCurrentProcess(id_W32GetCurrentProcess);
  865.   End;
  866. {/////////////////////////////////////////////////////////}
  867.   Function GetCurrentProcessId:Longint;
  868.   Begin
  869.       GetCurrentProcessId := W32GetCurrentProcessId(id_W32GetCurrentProcessId);
  870.   End;
  871. {/////////////////////////////////////////////////////////}
  872.   Function GetCurrentThread:Longint;
  873.   Begin
  874.       GetCurrentThread := W32GetCurrentThread(id_W32GetCurrentThread);
  875.   End;
  876. {/////////////////////////////////////////////////////////}
  877.   Function FileTimeToSystemTime(var lpft:tFILETIME;var lpst:tsystemtime):longbool;
  878.   Begin
  879.       FileTimeToSystemTime :=
  880.       W32FileTimeToSystemTime(lpft, lpst, id_W32FileTimeToSystemTime);
  881.   End;
  882. {/////////////////////////////////////////////////////////}
  883.   Function FileTimeToLocalFileTime(var lpft,lpftlocal:tFILETIME):longbool;
  884.   Begin
  885.     FileTimeToLocalFileTime:=
  886.     W32FileTimeToLocalFileTime(lpft, lpftlocal, id_W32FileTimeToLocalFileTime);
  887.   End;
  888. {/////////////////////////////////////////////////////////}
  889.   Function SystemTimeToFileTime(var lpst:tsystemtime;var lpft:tFILETIME):longbool;
  890.   Begin
  891.        SystemTimeToFileTime := W32SystemTimeToFileTime
  892.        (lpst,lpft,id_W32SystemTimeToFileTime);
  893.   End;
  894. {/////////////////////////////////////////////////////////}
  895.   Function LocalFileTimeToFileTime(var lpftlocal,lpft:tFILETIME):longbool;
  896.   Begin
  897.      LocalFileTimeToFileTime:= W32LocalFileTimeToFileTime
  898.      (lpftlocal,lpft,id_W32LocalFileTimeToFileTime);
  899.   End;
  900. {/////////////////////////////////////////////////////////}
  901.   Function GetCurrentDirectory(cchCurDir:longint;lpszCurDir:pchar):longint;
  902.   Begin
  903.        GetCurrentDirectory := W32GetCurrentDirectory
  904.        (cchCurDir, lpszCurDir,id_W32GetCurrentDirectory);
  905.   End;
  906. {/////////////////////////////////////////////////////////}
  907.   Function SetCurrentDirectory(lpszCurDir:pchar):longbool;
  908.   Begin
  909.       SetCurrentDirectory := W32SetCurrentDirectory
  910.        (lpszCurDir,id_W32SetCurrentDirectory);
  911.   End;
  912. {/////////////////////////////////////////////////////////}
  913.   Function CreateFile
  914.   (lpszName:pchar;fdwAccess,fdwShareMode:longint;lpsa:pointer;
  915.   fdwCreate,fdwAttrsAndFlags,hTemplateFile:longint):longint;
  916.   Begin
  917.        CreateFile := W32CreateFile
  918.        (lpszName,fdwAccess,fdwShareMode,lpsa,
  919.         fdwCreate,fdwAttrsAndFlags,hTemplateFile,id_W32CreateFile);
  920.   End;
  921. {/////////////////////////////////////////////////////////}
  922.   Function MoveFile(lpszExisting,lpszNew:pchar):longbool;
  923.   Begin
  924.        MoveFile := W32MoveFile
  925.        (lpszExisting,lpszNew,id_W32MoveFile);
  926.   End;
  927. {/////////////////////////////////////////////////////////}
  928.   Function GetLastError:longint;
  929.   Begin
  930.        GetLastError := W32GetLastError
  931.        (id_W32GetLastError);
  932.   End;
  933. {/////////////////////////////////////////////////////////}
  934.   Function CreateDirectory(path:pchar;security:pointer):longbool;
  935.   Begin
  936.        CreateDirectory := W32CreateDirectory
  937.        (path,security ,id_W32CreateDirectory);
  938.   End;
  939. {/////////////////////////////////////////////////////////}
  940.   Function RemoveDirectory(path:pchar):longbool;
  941.   Begin
  942.        RemoveDirectory := W32RemoveDirectory
  943.        (path ,id_W32RemoveDirectory);
  944.   End;
  945. {/////////////////////////////////////////////////////////}
  946.   Function SetFileAttributes(path:pchar;attr:longint):longbool;
  947.   Begin
  948.        SetFileAttributes := W32SetFileAttributes
  949.        (path,attr ,id_W32SetFileAttributes);
  950.   End;
  951. {/////////////////////////////////////////////////////////}
  952.   Function GetFileAttributes(path:pchar):longint;
  953.   Begin
  954.   GetFileAttributes :=$FFFFFFFF;
  955.   If id_W32GetFileAttributes>=0 then
  956.        GetFileAttributes:= W32GetFileAttributes
  957.        (path,id_W32GetFileAttributes);
  958.   End;
  959. {/////////////////////////////////////////////////////////}
  960.   Function Deletefile(path:pchar):longbool;
  961.   Begin
  962.        SetFileAttributes(path, File_Attribute_Archive);
  963.        Deletefile:= W32Deletefile
  964.        (path ,id_W32Deletefile);
  965.   End;
  966. {/////////////////////////////////////////////////////////}
  967.   Function SetFilePointer
  968.   (hFile,lDistanceToMove:longint;lpDistanceToMoveHigh:pointer;
  969.   dwMoveMethod:longint):longint;
  970.   Begin
  971.        SetFilePointer:= W32SetFilePointer
  972.        (hFile,lDistanceToMove,lpDistanceToMoveHigh,
  973.         dwMoveMethod,id_W32SetFilePointer);
  974.   End;
  975. {/////////////////////////////////////////////////////////}
  976.   Function SetFileTime
  977.   (hFile:longint;lpftCreation,lpftLastAccess,lpftLastWrite:pfiletime):longbool;
  978.   Begin
  979.        SetFileTime:= W32SetFileTime
  980.        (hFile,lpftCreation,lpftLastAccess,lpftLastWrite,id_W32SetFileTime);
  981.   End;
  982. {/////////////////////////////////////////////////////////}
  983.   Function GetFileTime
  984.   (hFile:longint;lpftCreation,lpftLastAccess,lpftLastWrite:pfiletime):longbool;
  985.   Begin
  986.        GetFileTime:= W32GetFileTime
  987.        (hFile,lpftCreation,lpftLastAccess,lpftLastWrite,id_W32GetFileTime);
  988.   End;
  989. {/////////////////////////////////////////////////////////}
  990.   Function ReadFile(hFile:longint;var lpBuffer;nNumberOfBytesToRead:longint;
  991.     var lpNumberOfBytesRead:longint;lpOverlapped:pointer):longbool;
  992.   Begin
  993.        ReadFile:= W32ReadFile
  994.        (hFile,lpBuffer,nNumberOfBytesToRead,lpNumberOfBytesRead,
  995.        lpOverlapped,id_W32ReadFile);
  996.   End;
  997. {/////////////////////////////////////////////////////////}
  998.   Function WriteFile(hFile:longint;var lpBuffer;nNumberOfBytesToWrite:longint;
  999.     var lpNumberOfBytesWritten:longint;lpOverlapped:pointer):longbool;
  1000.   Begin
  1001.        WriteFile := W32WriteFile
  1002.        (hFile,lpBuffer,nNumberOfBytesToWrite,lpNumberOfBytesWritten,
  1003.        lpOverlapped,id_W32WriteFile);
  1004.   End;
  1005. {/////////////////////////////////////////////////////////}
  1006.   Function FlushFileBuffers(hfile:longint):longbool;
  1007.   Begin
  1008.        FlushFileBuffers := W32FlushFileBuffers
  1009.        (hfile,id_W32FlushFileBuffers);
  1010.   End;
  1011. {/////////////////////////////////////////////////////////}
  1012. Function ShellExecute(hwnd:longint;lpszOp,lpszFile,lpszParams,lpszDir:pchar;
  1013. wShowCmd:longint):longint;
  1014. Begin
  1015.  ShellExecute:= W32ShellExecute(hwnd, lpszOp,lpszFile,lpszParams,lpszDir,
  1016.  wShowCmd,id_W32ShellExecute);
  1017. End;
  1018. {////////////////////////////////////////////////////////////////////}
  1019. Function GetDriveType(path:pchar): byte;
  1020. Begin
  1021.     GetDriveType:= W32GetDriveType(path ,id_W32GetDriveType);
  1022. End;
  1023. {////////////////////////////////////////////////////////////////////}
  1024. Function CopyFile(source, dest:pchar;SkipExisting:longbool):longbool;
  1025. Begin
  1026.     CopyFile:= W32CopyFile(source,dest,SkipExisting,id_W32CopyFile);
  1027. End;
  1028. {////////////////////////////////////////////////////////////////////}
  1029. Function GetFileSize(handle:longint;var hBit:longint):DWord;
  1030. Begin
  1031.    GetFileSize := W32GetFileSize(handle,hbit,id_W32GetFileSize);
  1032. End;
  1033. {////////////////////////////////////////////////////////////////////}
  1034. Function GetLogicalDriveStrings (bufsize:longint;buffer:pchar):longint;
  1035. Begin
  1036.     GetLogicalDriveStrings:= W32GetLogicalDriveStrings
  1037.     (bufsize,buffer ,id_W32GetLogicalDriveStrings);
  1038. End;
  1039. {////////////////////////////////////////////////////////////////////}
  1040. Function GetTempPath(bufsize:longint;buffer:pchar):longint;
  1041. Begin
  1042.    GetTempPath := W32GetTempPath(bufsize,buffer,id_W32GetTempPath);
  1043. End;
  1044. {////////////////////////////////////////////////////////////////////}
  1045. Function SearchPath(spath,fname,fExt:pchar;bufsize:longint;
  1046.               buffer,justfname:pchar):longint;
  1047. Begin
  1048.    SearchPath := W32SearchPath(spath,fname,fExt,bufsize,
  1049.    buffer,justfname,id_W32SearchPath);
  1050. End;
  1051. {////////////////////////////////////////////////////////////////////}
  1052. Function GetDC(ahwnd:longint):longint;
  1053. Begin
  1054.   GetDC:= W32GetDC (ahwnd ,id_W32GetDC);
  1055. End;
  1056. {/////////////////////////////////////////////////////////}
  1057. Function ReleaseDC(ahwnd,ahdc:Longint):longint;
  1058. Begin
  1059.   ReleaseDC:= W32ReleaseDC (ahwnd,ahdc ,id_W32ReleaseDC);
  1060. End;
  1061. {/////////////////////////////////////////////////////////}
  1062. Function PolyBezier(ahdc:longint;var points:tagPoint;count:Longint):Longint;
  1063. Begin
  1064.   PolyBezier:= W32PolyBezier
  1065.   (ahdc,points,count ,id_W32PolyBezier);
  1066. End;
  1067. {/////////////////////////////////////////////////////////}
  1068. Function GetDesktopWindow:longint;
  1069. Begin
  1070.   GetDesktopWindow:= W32GetDesktopWindow (id_W32GetDesktopWindow);
  1071. End;
  1072. {/////////////////////////////////////////////////////////}
  1073. Function CreatePen(style,w,c:Longint):Longint;
  1074. Begin
  1075.  CreatePen := W32CreatePen (style,w,c,id_W32CreatePen);
  1076. End;
  1077. {/////////////////////////////////////////////////////////}
  1078. Function SelectObject(ahdc,ahpen:longint):Longint;
  1079. Begin
  1080.   SelectObject:= W32SelectObject (ahdc,ahpen ,id_W32SelectObject);
  1081. End;
  1082. {/////////////////////////////////////////////////////////}
  1083. Function DeleteObject(ahpen:Longint):Longint;
  1084. Begin
  1085.   DeleteObject:= W32DeleteObject (ahpen ,id_W32DeleteObject);
  1086. End;
  1087. {/////////////////////////////////////////////////////////}
  1088. Function GetShortPathName(Ind,ud:pChar;UdSize:LongInt):Longint;
  1089. Begin
  1090.   GetShortPathName:=Strlen(Ind);
  1091.   If ID_W32getShortPathName>=0 then Begin
  1092.     getShortPathName:=W32GetShortPathName(Ind,ud,UdSize,ID_W32GetShortPathName);
  1093.   End Else StrlCopy(Ud,ind,UdSize);
  1094. End;
  1095. {/////////////////////////////////////////////////////////}
  1096. Function GetShortNameP(Fname:pChar):pChar;
  1097. Var
  1098.   Temp : pChar;
  1099. Begin
  1100.   getMem(Temp,512);
  1101.   If GetShortPathName(FName,Temp,511)=0 then StrLCopy(Temp,FName,511);
  1102.   StrCopy(FName,Temp);
  1103.   FreeMem(Temp,512);
  1104.   getShortNameP:=FName;
  1105. End;
  1106. {/////////////////////////////////////////////////////////}
  1107. Function  GetExitCodeProcess(hProcess:LongInt;    {The process to test}
  1108.                              Var ExitCode:LongInt)  {The returned code}
  1109.                              :LongBool;
  1110. Begin
  1111.   GetExitCodeProcess:=W32GetExitCodeProcess
  1112.   (hProcess, ExitCode,id_W32GetExitCodeProcess);
  1113. End;
  1114. {/////////////////////////////////////////////////////////}
  1115. Function FindExecutable(fname,dir,aResult:Pchar):longint;
  1116. Begin
  1117.    FindExecutable := W32FindExecutable(fname,dir,aResult,id_W32FindExecutable);
  1118. End;
  1119. {/////////////////////////////////////////////////////////}
  1120. function GlobalMemoryStatus(Var ms:MemoryStatus):longint;
  1121. Begin
  1122.  GlobalMemoryStatus := W32GlobalMemoryStatus(Ms, id_W32GlobalMemoryStatus);
  1123. End;
  1124. {/////////////////////////////////////////////////////////}
  1125. Function GetOpenFileName(Var LpOfn:T32OpenFilename):LongBool;
  1126. Begin
  1127.  GetOpenFileName:=W32GetOpenFileName(LpOFN, Id_W32GetOpenFileName);
  1128. End;
  1129. {/////////////////////////////////////////////////////////}
  1130. {/////////////////////////////////////////////////////////}
  1131. {/////////////////////////////////////////////////////////}
  1132. {/////////////////////////////////////////////////////////}
  1133. {/////////////////////////////////////////////////////////}
  1134. {hooks - not complete !!!! - had some major problems}
  1135. Var
  1136. W32CallNextHookEx:function(hhk, nCode, wParam, lParam, id:longint):LResult;
  1137. W32UnhookWindowsHookEx:function(hhk:HHook;id:longint):Longbool;
  1138. W32SetWindowsHookEx:Function (idHook:longint; Var hkprc:T32HookProc; hMod, dwThreadID,id:longint):HHook;
  1139.  
  1140. Var
  1141. Id_W32CallNextHookEx:longint;
  1142. id_W32UnhookWindowsHookEx:longint;
  1143. Id_W32SetWindowsHookEx:longint;
  1144.  
  1145. {///////////////////////////////////////////////////////////////}
  1146. Function CallNextHookEx(hhk, nCode, wParam, lParam:longint):LResult;
  1147. Begin
  1148.    If Not Use32Bit then begin
  1149.    end else
  1150.    CallNextHookEx :=
  1151.    W32CallNextHookEx(hhk, nCode, wParam, lParam, Id_W32CallNextHookEx);
  1152. End;
  1153. {///////////////////////////////////////////////////////////////}
  1154. Function UnhookWindowsHookEx(hhk:HHook):Longbool;
  1155. Begin
  1156.    If Not Use32Bit then begin
  1157.    end else
  1158.     UnhookWindowsHookEx:= W32UnhookWindowsHookEx(hhk, Id_W32UnhookWindowsHookEx);
  1159. End;
  1160. {///////////////////////////////////////////////////////////////}
  1161. Function SetWindowsHookEx(idHook:longint; hkprc:T32HookProc; hMod, dwThreadID:longint):HHook;
  1162. Begin
  1163.    If Not Use32Bit then begin
  1164.    end else
  1165.    SetWindowsHookEx :=
  1166.    W32SetWindowsHookEx(idHook, hkprc, hMod, dwThreadID,Id_W32SetWindowsHookEx);
  1167. End;
  1168. {///////////////////////////////////////////////////////////////}
  1169. {///////////////////////////////////////////////////////////////}
  1170. {///////////////////////////////////////////////////////////////}
  1171. {///////////////////////////////////////////////////////////////}
  1172. {///////////////////////////////////////////////////////////////}
  1173. Function ExistDirectory(aName:PChar):Boolean;
  1174. Var
  1175.   Temp : LongInt;
  1176.   Temp1 : File;
  1177.   Temp2 : Word;
  1178. Begin
  1179.   If Use32Bit then begin
  1180.     temp:=GetFileAttributes(aName);
  1181.     ExistDirectory:=temp=$00000010;
  1182.   End Else Begin
  1183.     Assign(Temp1,aName);
  1184.     GetfAttr(Temp1,Temp2);
  1185.     ExistDirectory:=
  1186.     ((Temp2 and faVolumeID)=0) and
  1187.     ((Temp2 and faDirectory)<>0) and (DosError=0);
  1188.   End;
  1189. End;
  1190. {/////////////////////////////////////////////////////////}
  1191. {/////////////////////////////////////////////////////////}
  1192. Function ExistFile(aName:PChar):Boolean;
  1193. Var
  1194.   Temp : LongInt;
  1195.   Temp1 : File;
  1196.   Temp2 : Word;
  1197. Begin
  1198.   If Use32Bit then begin
  1199.     temp:=GetFileAttributes(aName);
  1200.     ExistFile:= (temp<>$FFFFFFFF) and (temp<>$00000010);
  1201.   End Else Begin
  1202.     Assign(Temp1,aName);
  1203.     GetfAttr(Temp1,Temp2);
  1204.     ExistFile:=
  1205.     ((Temp2 and faVolumeID)=0) and
  1206.     ((Temp2 and faDirectory)=0) and (DosError=0);
  1207.   End;
  1208. End;
  1209. {/////////////////////////////////////////////////////////}
  1210. Function ExistFileOrDirectory(aName:PChar):Boolean;
  1211. Var
  1212.   Temp : LongInt;
  1213.   Temp1 : File;
  1214.   Temp2 : Word;
  1215. Begin
  1216.   If Use32Bit then begin
  1217.     temp:=GetFileAttributes(aName);
  1218.     ExistFileOrDirectory:=temp<>$FFFFFFFF;
  1219.   End Else Begin
  1220.     Assign(Temp1,aName);
  1221.     GetfAttr(Temp1,Temp2);
  1222.     ExistFileOrDirectory:=((Temp2 and faVolumeId)=0) and (DosError=0);
  1223.   End;
  1224. End;
  1225. {/////////////////////////////////////////////////////////}
  1226. Function IsUNCP(aName:pChar):Boolean;
  1227. Begin
  1228.   IsUNCP:=((Strlen(aName)>4) and (aName[0]='\') and (aName[1]='\')) and
  1229.     (StrScan(aName+3,'\')<>Nil);
  1230. End;
  1231. {/////////////////////////////////////////////////////////}
  1232. Function getFullPathName(FName:pChar;BufSize:LongInt;Buffer:pChar):Longint;
  1233. Var
  1234.   Tal : pChar;
  1235.   Save: pChar;
  1236. Begin
  1237.   If id_W32getFullPathName>=0 then begin
  1238.     getmem(tal, 260);
  1239.     getFullPathName:=
  1240.     W32getFullPathName(FName,BufSize,Buffer,Tal,id_W32GetFullPathName);
  1241.     freemem(tal, 260);
  1242.   end
  1243.   Else begin
  1244.     If IsUNCP(FName) Then begin
  1245.       Tal:=StrScan(StrScan(StrScan(StrScan(FName,'\')+1,'\')+1,'\')+1,'\');
  1246.       If Tal<>Nil Then begin
  1247.         GetMem(Save,260);
  1248.         FileExpand(Save,Tal);
  1249.         Tal[0]:=#0;
  1250.         StrCopy(Buffer,FName);
  1251.         Tal[0]:='\';
  1252.         StrCat(Buffer,Save+2);
  1253.         FreeMem(save,260);
  1254.       End Else
  1255.         FileExpand(Buffer,FName);
  1256.     End Else
  1257.       FileExpand(Buffer,FName);
  1258.     getFullPathName:=Strlen(Buffer);
  1259.   End;
  1260. End;
  1261. {/////////////////////////////////////////////////////////}
  1262. {/////////////////////////////////////////////////////////}
  1263. {/////////////////////////////////////////////////////////}
  1264. {/////////////////////////////////////////////////////////}
  1265. {/////////////////////////////////////////////////////////}
  1266. {/////////////////////////////////////////////////////////}
  1267. {/////////////////////////////////////////////////////////}
  1268. function W32WinExec(p:pchar;mode:longint):longint;
  1269. {A Win32 WinExec function - calls CreateProcess -
  1270. seems to work okay}
  1271. Var
  1272. Code,
  1273. i,j:longint;
  1274. ts:TStartupinfo;
  1275. pi:process_information;
  1276. p2,p3:pchar;
  1277. b    :longbool;
  1278.  
  1279. begin
  1280.     W32WinExec := 0;
  1281.     If Not Use32Bit then begin
  1282.        W32WinExec:=WinProcs.WinExec(p,mode);
  1283.        Exit;
  1284.     end;
  1285.  
  1286.     FillChar(ts, Sizeof(ts), 0);
  1287.     With ts do begin
  1288.       cb := sizeof(ts);
  1289.      wShowWindow := mode;
  1290.     end;
  1291.  
  1292.  
  1293.    getmem(p3,512);
  1294.    {
  1295.    getmem(p2,512);
  1296.    Code := FindExecutable(p, '', p2);
  1297.    If code > 32 then begin
  1298.     Strcopy(p3, p2);
  1299.     Strcat(p3, ' ');
  1300.     Strcat(p3, p);
  1301.    end
  1302.    else Strcopy(p3, p);
  1303.    freemem(p2, 512);
  1304.    }
  1305.    Strcopy(p3, p);
  1306.  
  1307.    b:= CreateProcess
  1308.    (Nil, p3, nil, Nil, false, NORMAL_PRIORITY_CLASS, Nil, Nil, ts, pi);
  1309.  
  1310.    freemem(p3, 512);
  1311.  
  1312.    If b = false then exit;
  1313.    i := pi.hProcess;
  1314.    W32WinExec := pi.dwProcessId;
  1315.    CloseHandle(i);
  1316. end;
  1317. {/////////////////////////////////////////////////////////}
  1318. {/////////////////////////////////////////////////////////}
  1319. {/////////////////////////////////////////////////////////}
  1320. {/////////////////////////////////////////////////////////}
  1321. {/////////////////////////////////////////////////////////}
  1322. {/////////////////////////////////////////////////////////}
  1323. Procedure InitialiseWin32;far;
  1324. {initialise all the Win32 functions}
  1325. Begin
  1326.  
  1327.   {first assign the functions to Call32 - in Call32NT.PAS}
  1328.   @W32FindFirstFile:=@Call32;
  1329.   @W32FindNextFile:=@Call32;
  1330.   @W32FindClose:=@Call32;
  1331.   @W32FileTimeToSystemTime:=@Call32;
  1332.   @W32FileTimeToLocalFileTime:=@Call32;
  1333.   @W32SystemTimeToFileTime:=@Call32;
  1334.   @W32LocalFileTimeToFileTime:=@Call32;
  1335.   @W32GetCurrentDirectory:=@Call32;
  1336.   @W32SetCurrentDirectory:=@Call32;
  1337.   @W32CreateFile:=@Call32;
  1338.   @W32MoveFile:=@Call32;
  1339.   @W32GetLastError:=@Call32;
  1340.   @W32CreateDirectory:=@Call32;
  1341.   @W32RemoveDirectory:=@Call32;
  1342.   @W32SetFileAttributes:=@Call32;
  1343.   @W32GetFileAttributes:=@Call32;
  1344.   @W32Deletefile:=@Call32;
  1345.   @W32SetFilePointer:=@Call32;
  1346.   @W32setFileTime:=@Call32;
  1347.   @W32GetFileTime:=@Call32;
  1348.   @W32CloseHandle:=@Call32;
  1349.   @W32ReadFile:=@Call32;
  1350.   @W32WriteFile:=@Call32;
  1351.   @W32FlushFileBuffers:=@Call32;
  1352.   @W32ShellExecute:=@Call32;
  1353.   @W32WaitForSingleObject:=@Call32;
  1354.   @W32CreateProcess:=@Call32;
  1355.   @W32GetCurrentThread:=@Call32;
  1356.   @W32GetCurrentProcess:=@Call32;
  1357.   @W32GetCurrentProcessId:=@Call32;
  1358.  
  1359.   {}
  1360.   @W32GetFileSize:=@Call32;
  1361.   @W32CopyFile:=@Call32;
  1362.   @W32GetDriveType:=@Call32;
  1363.   @W32GetLogicalDriveStrings:=@Call32;
  1364.   @W32GetTempPath:=@Call32;
  1365.   @W32SearchPath:=@Call32;
  1366.   @W32GetFullPathName:=@Call32;
  1367.   @W32FindExecutable:=@Call32;
  1368.   @W32GlobalMemoryStatus:=@Call32;
  1369.   {}
  1370.   @W32GetDC:=@Call32;
  1371.   @W32ReleaseDC:=@Call32;
  1372.   @W32PolyBezier:=@Call32;
  1373.   @W32GetDesktopWindow:=@Call32;
  1374.   @W32CreatePen:=@Call32;
  1375.   @W32SelectObject:=@Call32;
  1376.   @W32DeleteObject:=@Call32;
  1377.   @W32GetExitCodeProcess:=@Call32;
  1378.   @W32GetShortPathName:=@Call32;
  1379.  
  1380.   @W32SetEnvironmentVariable:=@Call32;
  1381.   @W32GetEnvironmentVariable:=@Call32;
  1382.  
  1383.   {Then get the win32 functions from their DLLs}
  1384.   {First:  The name of the original win32 function: CASE SENSITIVE!!!!!}
  1385.   {Second: The name of the 32 bit module where the function is located}
  1386.   {Third:  A string describing all parameters. p=pointer, i=longint, w=Windows handle}
  1387.   id_W32SetEnvironmentVariable:=Declare32('SetEnvironmentVariable', 'kernel32', 'pp');
  1388.   id_W32GetEnvironmentVariable:=Declare32('GetEnvironmentVariable', 'kernel32', 'ppi');
  1389.  
  1390.   id_W32GetDriveType:=Declare32('GetDriveType', 'kernel32', 'p');
  1391.   id_W32GetFileSize:=Declare32('GetFileSize', 'kernel32', 'ip');
  1392.  
  1393.   id_W32CopyFile:=Declare32('CopyFile', 'kernel32', 'ppi');
  1394.   id_W32GetLogicalDriveStrings:=Declare32('GetLogicalDriveStrings', 'kernel32', 'ip');
  1395.   id_W32GlobalMemoryStatus:=Declare32('GlobalMemoryStatus', 'kernel32', 'p');
  1396.  
  1397.   id_W32GetTempPath:=Declare32('GetTempPath', 'kernel32', 'ip');
  1398.   id_W32SearchPath:=Declare32('SearchPath', 'kernel32', 'pppipp');
  1399.   id_W32GetFullPathName:=Declare32('GetFullPathName', 'kernel32', 'pipp');
  1400.   id_W32FindExecutable:=Declare32('FindExecutable', 'shell32', 'ppp');
  1401.  
  1402.   id_W32FindFirstFile:=Declare32('FindFirstFile', 'kernel32', 'pp');
  1403.   id_W32FindNextFile:=Declare32('FindNextFile', 'kernel32', 'ip');
  1404.   id_W32FindClose:=Declare32('FindClose', 'kernel32', 'i');
  1405.   id_W32FileTimeToSystemTime:=Declare32('FileTimeToSystemTime', 'kernel32', 'pp');
  1406.   id_W32FileTimeToLocalFileTime:=Declare32('FileTimeToLocalFileTime', 'kernel32', 'pp');
  1407.   id_W32SystemTimeToFileTime:=Declare32('SystemTimeToFileTime','kernel32','pp');
  1408.   id_W32LocalFileTimeToFileTime:=Declare32('LocalFileTimeToFileTime','kernel32','pp');
  1409.   id_W32GetCurrentDirectory:=Declare32('GetCurrentDirectory','kernel32','ip');
  1410.   id_W32SetCurrentDirectory:=Declare32('SetCurrentDirectory','kernel32','p');
  1411.   id_W32CreateFile:=Declare32('CreateFile','kernel32','piipiii');
  1412.   id_W32MoveFile:=Declare32('MoveFile','kernel32','pp');
  1413.   id_W32GetLastError:=Declare32('GetLastError','kernel32','');
  1414.   id_W32CreateDirectory:=Declare32('CreateDirectory','kernel32','pp');
  1415.   id_W32RemoveDirectory:=Declare32('RemoveDirectory','kernel32','p');
  1416.   id_W32SetFileAttributes:=Declare32('SetFileAttributes','kernel32','pi');
  1417.   id_W32GetFileAttributes:=Declare32('GetFileAttributes','kernel32','p');
  1418.   id_W32Deletefile:=Declare32('DeleteFile','kernel32','p');
  1419.   id_W32SetFilePointer:=Declare32('SetFilePointer','kernel32','iipi');
  1420.   id_W32setFileTime:=Declare32('SetFileTime','kernel32','ippp');
  1421.   id_W32GetFileTime:=Declare32('GetFileTime','kernel32','ippp');
  1422.   id_W32ReadFile:=Declare32('ReadFile','kernel32','ipipp');
  1423.   id_W32WriteFile:=Declare32('WriteFile','kernel32','ipipp');
  1424.   id_W32FlushFileBuffers:=Declare32('FlushFileBuffers','kernel32','i');
  1425.  
  1426.   {process functions }
  1427.   id_W32GetCurrentThread:=Declare32('GetCurrentThread','kernel32','i');
  1428.   id_W32GetCurrentProcess:=Declare32('GetCurrentProcess','kernel32','i');
  1429.   id_W32GetCurrentProcessId:=Declare32('GetCurrentProcessId','kernel32','i');
  1430.   id_W32ShellExecute:=Declare32('ShellExecute','shell32','wppppi');
  1431.   id_W32CreateProcess:=Declare32('CreateProcess','kernel32','ppppiipppp');
  1432.   id_W32WaitForSingleObject:=Declare32('WaitForSingleObject','kernel32','ii');
  1433.   id_W32CloseHandle:=Declare32('CloseHandle','kernel32','i');
  1434.  
  1435.   id_W32GetDC:=Declare32('GetDC', 'user32', 'w');
  1436.   id_W32ReleaseDC:=Declare32('ReleaseDC', 'user32', 'wi');
  1437.   id_W32PolyBezier:=Declare32('PolyBezier', 'gdi32', 'ipi');
  1438.   id_W32CreatePen:=Declare32('CreatePen', 'gdi32', 'iii');
  1439.   id_W32SelectObject:=Declare32('SelectObject', 'gdi32', 'ii');
  1440.   id_W32DeleteObject:=Declare32('DeleteObject', 'gdi32', 'i');
  1441.  
  1442.   id_W32GetExitCodeProcess:=Declare32('GetExitCodeProcess','kernel32','ip');
  1443.   id_W32GetShortPathName:= Declare32('GetShortPathName', 'Kernel32','ppi');
  1444.  
  1445.   {hooks; not fully functional }
  1446.   @W32CallNextHookEx:=@Call32;
  1447.   @W32UnhookWindowsHookEx:=@Call32;
  1448.   @W32SetWindowsHookEx:=@Call32;
  1449.   Id_W32CallNextHookEx:=Declare32('CallNextHookEx', 'user32','iiii');
  1450.   id_W32UnhookWindowsHookEx:=Declare32('UnhookWindowsHookEx', 'user32','i');
  1451.   Id_W32SetWindowsHookEx:=Declare32('SetWindowsHookEx', 'user32','ipii');
  1452.   {}
  1453.  
  1454.   {file dialogs; doesn't work!}
  1455.    @W32GetOpenFileName:=@Call32;
  1456.    Id_W32GetOpenFileName:=Declare32('GetOpenFileName','comdlg32','p');
  1457. End{InitialiseWin32};
  1458.  
  1459. {/////////////////////////////////////////////////////////}
  1460. {/////////////////////////////////////////////////////////}
  1461. Function IsWinNT : Boolean;
  1462. {Is this Windows NT?}
  1463. const
  1464. WF_WINNT = $4000;
  1465. var
  1466. l:longint;
  1467. Begin
  1468.   l := WinProcs.getWinFlags;
  1469.   IsWinNT :=  l and WF_WinNT <> 0;
  1470. End;
  1471. {/////////////////////////////////////////////////////////}
  1472. {/////////////////////////////////////////////////////////}
  1473. Function W32FullPathName(s:string):String;
  1474. {return a fully qualified path for a file/directory
  1475. which you know to exist}
  1476. Var
  1477. s1:^string;
  1478. Begin
  1479.     W32FullPathName:=s;
  1480.     If Not Use32Bit then exit;
  1481.  
  1482.     new(s1);
  1483.     s1^:=PathNameOnly(s);
  1484.     if s1^>'' then begin
  1485.       If W32IsDirectory(s1^) then begin
  1486.          s:=addbackslash(s1^)+FilenameOnly(s);
  1487.       end;
  1488.     end else s:= addbackslash(W32ShowDir)+s;
  1489.  
  1490.     W32FullPathName:=GetlongFname(s);
  1491.     dispose(s1);
  1492. End;
  1493. {/////////////////////////////////////////////////////////}
  1494. Function W32MkDir(s:String): longint;
  1495. {Make a directory - with long filename support
  1496.  Use Ioresult as normal - if successful, IoResult will be 0
  1497.  if not successful, I implement a kludge to force an IO error
  1498.  so that IoResult <> 0
  1499.  
  1500.  e.g.,
  1501.    s := 'D:\This is a Long.Directory Name';
  1502.    W32MkDir(s);
  1503.    If IoResult <> 0 then Writeln('Error')
  1504.    else s:=GetShortFName(s);
  1505. }
  1506. Var
  1507. i:integer;
  1508. p:array[0..260] of char;
  1509. b:longbool;
  1510.  
  1511. Begin
  1512.     W32MkDir := -1;
  1513.     s:=StripChar(s,'"');
  1514.  
  1515.     {path starts with "\"}
  1516.     if (s[1]='\') then if Not IsUNC(s) then begin
  1517.        s:=ThisDrive+s;
  1518.     end;
  1519.  
  1520.  
  1521.     If Use32Bit then
  1522.     begin
  1523.       Strpcopy(p, W32FullPathName(s));
  1524.       b := CreateDirectory(p, Nil);
  1525.       W32MkDir := GetLastError;
  1526.       If b = TRUE then
  1527.       begin
  1528.         W32MkDir := 0;
  1529.         i := ioresult; {clear ioresult}
  1530.       end Else begin
  1531.          {force an io error so that ioresult<>0}
  1532.          s:='Z:\Z\!┌⌠÷$Θ∙.╙≤╟'; {bad directory - this is the worst I can come up with!}
  1533.          System.ChDir(s);
  1534.       end;
  1535.     End {Use32Bit}
  1536.     else begin
  1537.       System.MkDir(s);
  1538.     End;
  1539. End;
  1540. {/////////////////////////////////////////////////////////}
  1541. Function W32Chdir(s:String): longint;
  1542.  {change directory - with long filename support
  1543.  Use Ioresult as normal - if successful, IoResult will be 0
  1544.  if not successful, I implement a kludge to force an IO error
  1545.  so that IoResult <> 0
  1546.  }
  1547. Begin
  1548.     W32Chdir := -1;
  1549.     s:=StripChar(s,'"');
  1550.  
  1551.     {path starts with "\"}
  1552.     if (s[1]='\') then if Not IsUNC(s) then begin
  1553.        s:=ThisDrive+s;
  1554.     end;
  1555.  
  1556.     If (Use32Bit) then
  1557.     begin
  1558.     {I would use SetCurrentDirectory() here - but it doesn't work
  1559.      under NT - so I am using the system unit's ChDir procedure,
  1560.      with a long filename having been converted to a short filename}
  1561.       If W32IsDirectory(s) then begin
  1562.          System.ChDir(GetShortFName(s));
  1563.          if ioresult=0 then begin
  1564.            W32Chdir:=0;
  1565.            exit;
  1566.          end;
  1567.       end;
  1568.       {ChDir did not work; force an io error so that ioresult<>0}
  1569.       s:='Z:\Z\!┌⌠÷$Θ∙.╙≤╟'; {bad directory}
  1570.       System.ChDir(s);
  1571.     end {Use32bit}
  1572.     else begin
  1573.       System.ChDir(s)
  1574.     end;
  1575. End;
  1576. {/////////////////////////////////////////////////////////}
  1577. Function W32RmDir(s:String): longint;
  1578. {remove a directory - with long filename support;
  1579.  Use Ioresult as normal - if successful, IoResult will be 0
  1580.  if not successful, I implement a kludge to force an IO error
  1581.  so that IoResult <> 0
  1582. }
  1583. Var
  1584. i:integer;
  1585. p:array[0..260] of char;
  1586. b:longbool;
  1587.  
  1588. Begin
  1589.     W32RmDir := -1;
  1590.     s:=StripChar(s,'"');
  1591.  
  1592.     {path starts with "\"}
  1593.     if (s[1]='\') then if Not IsUNC(s) then begin
  1594.        s:=ThisDrive+s;
  1595.     end;
  1596.  
  1597.     If Use32Bit then begin
  1598.       Strpcopy(p, W32FullPathName(s));
  1599.       b:=RemoveDirectory(p);
  1600.       W32RmDir := GetLastError;
  1601.  
  1602.       if b = TRUE then
  1603.       begin
  1604.         W32RmDir := 0;
  1605.         i := ioresult;
  1606.       end {b=true}
  1607.       Else begin
  1608.          {force an io error so that ioresult<>0}
  1609.          s:='Z:\Z\!┌⌠÷$Θ∙.╙≤╟'; {bad directory}
  1610.          System.ChDir(s);
  1611.       end; {b=false}
  1612.     End {Use32Bit}
  1613.     else begin
  1614.       System.RmDir(s)
  1615.     End;
  1616. End;
  1617. {/////////////////////////////////////////////////////////}
  1618. {///////////////////////////////////////////////////////////}
  1619. Function W32Rewrite(var fname:string):longint;
  1620. (*
  1621.  {Create a file, with long file name support, and
  1622.  return the short filename if the creation is successful
  1623.  Typical use:}
  1624.  
  1625.    var
  1626.    f:text;
  1627.    s:string;
  1628.    l:longint;
  1629.  
  1630.    begin
  1631.      s :='C:\MY Long fileName.Extension.See.Okay';
  1632.      l := W32Rewrite(s);  {create long name}
  1633.      If (l <> Invalid_Handle_Value) then begin {success}
  1634.        W32Close(l);  {make sure you close it!!!!!}
  1635.        Assign(f, s); {assign short name to your text file}
  1636.        ReWrite(f);   {now create it again - but you already have a long name!}
  1637.      end else Writeln('Error creating file');
  1638.    end.
  1639. *)
  1640. Var
  1641. l:longint;
  1642. Begin
  1643.    W32Rewrite:=-1;
  1644.    if not Use32Bit then exit;
  1645.  
  1646.    {if file exists - reset the attribute}
  1647.    SetFileAttributes(Str2PChar(FName), File_Attribute_Archive);
  1648.  
  1649.    l:= CreateFile(Str2pchar(fname),
  1650.    Generic_Read+Generic_Write,
  1651.    File_Share_Read,
  1652.    Nil,
  1653.    Create_Always,
  1654.    File_Attribute_Normal,
  1655.    0);
  1656.    W32Rewrite:=l;
  1657.  
  1658.    {if success, return short filename;for my own programs -
  1659.    to avoid having to do this manually each time}
  1660.    If l<>Invalid_Handle_Value then
  1661.    fName := GetShortFName(FName);
  1662. End;
  1663. {///////////////////////////////////////////////////////////}
  1664. Function W32Reset(fname:string):longint;
  1665. {open a file - with long filename support;
  1666.  Win32 file write functions must be used to write to the file}
  1667. Begin
  1668.    If Not Use32Bit then exit;
  1669.    W32Reset:= CreateFile(Str2pchar(fname),
  1670.    Generic_Read+Generic_Write,
  1671.    File_Share_Read,
  1672.    Nil,
  1673.    Open_Existing,
  1674.    File_Attribute_Normal,
  1675.    0);
  1676. End;
  1677. {///////////////////////////////////////////////////////////}
  1678. Function W32Close(handle:longint):longbool;
  1679. {Close a File handle}
  1680. Begin
  1681.    If Not Use32Bit then exit;
  1682.    W32Close:=CloseHandle(handle);
  1683. End;
  1684. {///////////////////////////////////////////////////////////}
  1685. {///////////////////////////////////////////////////////////}
  1686. function isUNC(Const s:string):boolean;
  1687. {is a file/directory name a UNC name?}
  1688. begin
  1689.    IsUNC := (s[1]='\') and (s[2]='\') and (Length(s) > 3);
  1690. end;
  1691. {/////////////////////////////////////////////////}
  1692. Function AddBackSlash(s:String):String;
  1693. {add a backslash if there wasn't one}
  1694. Begin
  1695.   if s[length(s)]<>'\' then s:=s+'\';
  1696.   AddBackSlash:=s;
  1697. End;
  1698. {/////////////////////////////////////////////////}
  1699. Function PathNameOnly(s:String):String;
  1700. {return the path only - strip filename out}
  1701. Var
  1702. i:word;
  1703. begin
  1704.    PathNameOnly:='';
  1705.    if (s[1] in ['\','/']) and (ISUnc(s)=False) then begin
  1706.      PathNameOnly:=s[1];
  1707.      exit;
  1708.    end;
  1709.  
  1710.    for i:=length(s) downto 0 do if s[i] in [':','\','/'] then break;
  1711.    if i>0 then begin
  1712.      s:=copy(s,1,i);
  1713.      if i > 1 then begin
  1714.        if s[pred(i)] in [':','\','/'] then {ignore} else
  1715.        begin
  1716.           if s[i]<>':' then Delete(s,i,1);
  1717.        end;
  1718.      end;
  1719.      PathNameOnly:=s;
  1720.    end;
  1721. end;
  1722. {/////////////////////////////////////////////////}
  1723. {/////////////////////////////////////////////////}
  1724. Function FileNameOnly(s:String):String;
  1725. {return the filename only - strip path out}
  1726. Var
  1727. i:Word;
  1728.  
  1729. begin
  1730.    FileNameOnly:=s;
  1731.    for i:=length(s) downto 0 do if s[i] in [':','\','/'] then break;
  1732.    if i>0 then
  1733.    begin
  1734.      Delete(s,1,i);
  1735.      FileNameOnly:=s;
  1736.    end;
  1737. end;
  1738. {/////////////////////////////////////////////////}
  1739. Function AddNull(S:String):String;
  1740. {add a null character to a string}
  1741. Var
  1742. i:Word;
  1743. Begin
  1744.    i:=length(s);
  1745.    If s[i]<>#0 then s[i]:=#0;
  1746.    AddNull := s;
  1747. End;
  1748. {/////////////////////////////////////////////////}
  1749. Function StripChar(s:string;ch:char):string;
  1750. {remove all occurences of "ch" from "s"}
  1751. var
  1752. i:Word;
  1753. begin
  1754.    for i:=1 to length(s) do
  1755.    if s[i]=ch then Delete(s,i,1);
  1756.    StripChar:=s;
  1757. end;
  1758. {/////////////////////////////////////////////////}
  1759. Function StripQuotes(s:String):String;
  1760. {remove beginning and ending quotation marks from a string }
  1761. Var
  1762. i:word;
  1763. Begin
  1764.   i:=length(s);
  1765.   If (s[1]='"') and (s[i]='"') then begin
  1766.     Delete(s,i,1);
  1767.     Delete(s,1,1);
  1768.   end;
  1769.   StripQuotes:=s;
  1770. End;
  1771. {/////////////////////////////////////////////////}
  1772. Function Str2PChar(Var S:String):PChar;
  1773. {convert a string to a pchar}
  1774. Var
  1775. i :word;
  1776. s1:string;
  1777. Begin
  1778.    s1:=s;
  1779.    i:=length(s);
  1780.    If s[i]<>#0 then s:=s+#0;
  1781.    Str2PChar:=@s[1];
  1782.    s:=s1;
  1783. End;
  1784. {/////////////////////////////////////////////////////////}
  1785. Function W32ShowDir:String;
  1786. {get the current directory name - with long name support}
  1787. Var
  1788. p:array[0..260] of char;
  1789. s1,
  1790. s:string;
  1791. Begin
  1792.     If Use32Bit then
  1793.     begin
  1794.       GetCurrentDirectory(260, p);
  1795.       s1:=AddBackSlash(GetLongFName(PathNameonly(Strpas(p))));
  1796.       s:=GetLongFName(Strpas(p));
  1797.       s :=s1+FileNameOnly(s);
  1798.       W32ShowDir:=s;
  1799.     end
  1800.     else
  1801.     begin
  1802.       GetDir(0, s);
  1803.       W32ShowDir:=s;
  1804.     end;
  1805. End;
  1806. {/////////////////////////////////////////////////}
  1807. Function GetShortFName(FName:String):String;
  1808. {get the short name of a file name - doesn't exist in NT 3.1}
  1809. Var
  1810. Temp:Pchar;
  1811. Begin
  1812.    GetShortFName := FName;
  1813.    If Not Use32Bit then Exit;
  1814.    Fname:=Fname+#0;
  1815.    getmem(temp, 261);
  1816.    If GetShortPathName(@Fname[1],Temp,260)>0 then
  1817.    GetShortFName := StrPas(temp);
  1818.    freemem(temp, 261);
  1819. End;
  1820. {/////////////////////////////////////////////////}
  1821. Function W32GetLongFileName(Ind:pChar;NumChar:LongInt;Ud:pChar):LongInt;
  1822. {get a long filename from short one}
  1823. Var
  1824.   W      : Longint;
  1825.   L      : WIN32_FIND_DATA;
  1826.   Old,SeekIt,TheEnd,Ind1,
  1827.   Temp2  : pChar;
  1828. Begin
  1829.   If Not(Use32Bit) then begin
  1830.     GetMem(Ind1,512);
  1831.     While (Strlen(Ind)>0) and ((StrEnd(Ind)-1)^='\') DO
  1832.       (StrEnd(Ind)-1)^:=#0;
  1833.     getFullPathName(Ind,512,Ind1);
  1834.     If Not(ExistFileOrDirectory(Ind1)) Then
  1835.       Ud[0]:=#0
  1836.     Else
  1837.       StrLCOPy(Ud,Ind1,NumChar);
  1838.     FreeMem(Ind1,512);
  1839.   End else Begin
  1840.     GetMem(Ind1,512);
  1841.     GetMem(Old,512);
  1842.     GetMem(TheEnd,512);
  1843.     getFullPathName(Ind,512,Ind1);
  1844.     If Not(ExistFileOrDirectory(Ind1)) Then
  1845.       Ind1[0]:=#0;
  1846.     If IsUncP(Ind1) then
  1847.       Temp2:=StrScan(StrScan(StrScan(StrScan(Ind1,'\')+1,'\')+1,'\')+1,'\')
  1848.     Else
  1849.       Temp2:=StrScan(Ind1,'\');
  1850.     If Temp2<>Nil Then Begin
  1851.       Temp2[0]:=#0;
  1852.       StrCopy(Old,Ind1);
  1853.       Temp2[0]:='\';
  1854.       StrCopy(TheEnd,Old);
  1855.       Inc(temp2);
  1856.       SeekIt:=StrScan(Temp2,'\');
  1857.       While SeekIt<>Nil Do Begin
  1858.         SeekIt[0]:=#0;
  1859.         StrCat(Old,'\');
  1860.         StrCat(Old,Temp2);
  1861.         SeekIt[0]:='\';
  1862.         Temp2:=SeekIt+1;
  1863.         SeekIt:=StrScan(Temp2,'\');
  1864.         W:=FindFirstfile(Old,L);
  1865.         StrCat(TheEnd,'\');
  1866.         StrCat(TheEnd,L.cFileName);
  1867.         FindClose(W);
  1868.       End;
  1869.       If Temp2[0]<>#0 Then Begin
  1870.         StrCat(Old,'\');
  1871.         StrCat(Old,Temp2);
  1872.         W:=FindFirstfile(Old,L);
  1873.         StrCat(TheEnd,'\');
  1874.         StrCat(TheEnd,L.cFileName);
  1875.         FindClose(W);
  1876.       End;
  1877.       StrLCopy(Ud,TheEnd,NumChar);
  1878.     End Else Ud[0]:=#0;
  1879.     FreeMem(TheEnd,512);
  1880.     FreeMem(Old,512);
  1881.     FreeMem(Ind1,512);
  1882.   End;
  1883.   While (Strlen(Ud)>0) and ((StrEnd(Ud)-1)^='\') DO (StrEnd(Ud)-1)^:=#0;
  1884.   W32GetLongFileName:=Strlen(Ud);
  1885. End;
  1886. {/////////////////////////////////////////////////////////}
  1887. {/////////////////////////////////////////////////////////}
  1888. {/////////////////////////////////////////////////////////}
  1889. Function GetLongFName(Const FName:String):String;
  1890. {get a long filename, using a String instead of PChar}
  1891. var
  1892. p:pchar;
  1893. s1,
  1894. s:^string;
  1895. begin
  1896.   GetLongFName:=FName;
  1897.   getmem(p, 261);
  1898.   new(s);
  1899.   new(s1);
  1900.  
  1901.   s^:=FName;
  1902.   If ExistDirectory(Str2PChar(s^)) then {it's a directory}
  1903.   begin
  1904.      getdir(0, s1^);
  1905.      System.chdir(GetShortFName(s^));
  1906.      if ioresult=0 then begin
  1907.        getdir(0, s^);
  1908.      end;
  1909.      system.chdir(s1^); if ioresult=0 then;
  1910.   end;
  1911.  
  1912.   If W32GetLongFileName(Str2PChar(s^), 260, p)>0 then
  1913.   begin
  1914.     If (Length(FName)=3) and (Fname[2]=':') and (Fname[3]='\')
  1915.     then {its a root directory - don't change it}
  1916.     else
  1917.     GetLongFName:=StrPas(p);
  1918.   end;
  1919.   freemem(p, 261);
  1920.   dispose(s);
  1921.   dispose(s1);
  1922. end;
  1923. {/////////////////////////////////////////////////////////}
  1924. {/////////////////////////////////////////////////////////}
  1925. {/////////////////////////////////////////////////////////}
  1926. Function GetFullFName(Const FName:String):String;
  1927. Var
  1928. p2,
  1929. p:pchar;
  1930. s1,s2:string;
  1931.  
  1932. Begin
  1933.     GetFullFName:=FName;
  1934.     If Not Use32Bit then Exit;
  1935.  
  1936.     getDir(0, s2);{save current}
  1937.     s1:=PathnameOnly(FName);
  1938.     if s1>'' then begin
  1939.        System.Chdir(GetShortFName(s1));
  1940.        if ioresult=0 then;
  1941.     end;
  1942.  
  1943.     s1:=FName;
  1944.  
  1945.     getmem(p, 261);
  1946.     getmem(p2, 255);
  1947.  
  1948.     strpcopy(p2, s1);
  1949.     If GetFullPathName(p2, 260, p)>0
  1950.     then begin
  1951.        GetFullFName:= StrPas(p);
  1952.     end;
  1953.  
  1954.     System.Chdir(s2); if ioresult=0 then;
  1955.  
  1956.     freemem(p, 261);
  1957.     freemem(p2, 255);
  1958. End;
  1959. {/////////////////////////////////////////////////}
  1960. Function W32Move(TheOld, TheNew:String):longbool;
  1961. {move a file, by renaming it; if TheNew exists,
  1962. it will try to delete it and then do a rename}
  1963. Var
  1964. b:longbool;
  1965. Begin
  1966.     W32Move:=False;
  1967.     If Not Use32Bit then exit;
  1968.  
  1969.     b := MoveFile(Str2PChar(TheOld), Str2PChar(TheNew));
  1970.     if not b then
  1971.     begin  {error}
  1972.        If W32Exist(TheOld) then {does the old file exist?}
  1973.        begin
  1974.           If DeleteFile(Str2PChar(TheNew)) {try to delete the new one}
  1975.           then                             {if success, then move again}
  1976.           b := MoveFile(Str2PChar(TheOld), Str2PChar(TheNew));
  1977.        end;
  1978.     end;
  1979.     W32Move := b;
  1980. End;
  1981. {/////////////////////////////////////////////////}
  1982. Function W32Rename(TheOld, TheNew:String):longbool;
  1983. {rename a file - TheNew must not exist already}
  1984. Var
  1985. b:longbool;
  1986. Begin
  1987.     If Not Use32Bit then exit;
  1988.     b := MoveFile(Str2PChar(TheOld), Str2PChar(TheNew));
  1989.     W32Rename := b;
  1990. End;
  1991. {/////////////////////////////////////////////////////////}
  1992. Function W32Exist(Var FName:String):Boolean;
  1993. Var
  1994. i:longint;
  1995. s,s1,s2:string;
  1996. Begin
  1997.    If Not Use32Bit then exit;
  1998.    getDir(0, s2);{save current}
  1999.  
  2000.    s1:= StripChar(FName,'"');
  2001.    s1:=PathnameOnly(s1);
  2002.  
  2003.    If s1>'' then begin
  2004.      System.Chdir(GetShortFName(s1));
  2005.       if ioresult=0 then begin
  2006.          GetDir(0,s1);
  2007.          If Not IsUNC(FName) then
  2008.          FName := AddBackSlash(GetLongFName(s1))+FileNameOnly(FName);
  2009.       end;
  2010.    end;
  2011.  
  2012.    W32Exist:=False;
  2013.    i:= CreateFile(Str2pchar(FName),Generic_Read,File_Share_Read,
  2014.    Nil,Open_Existing,File_Attribute_Normal,0);
  2015.    if i <> Invalid_Handle_Value then begin
  2016.       CloseHandle(i);
  2017.       W32Exist:=True;
  2018.       If Not IsUNC(FName) then begin
  2019.         s := PathNameOnly(FName);
  2020.         s1:= GetLongFName(FName);
  2021.         If (s = '') then FName:=s1
  2022.         else FName:=AddBackSlash(s)+FileNameOnly(s1);
  2023.       end;
  2024.    end;
  2025.    System.Chdir(s2);if ioresult<>0 then;
  2026. End;
  2027. {/////////////////////////////////////////////////////////}
  2028. Function W32IsDirectory(Var DirName:String):Boolean;
  2029. {does the directory DIRNAME exist?}
  2030. Var
  2031. s1,s2:string;
  2032.  
  2033. Begin
  2034.    W32IsDirectory:=False;
  2035.    If DirName='' then Exit;
  2036.    If Not Use32Bit then exit;
  2037.  
  2038.    s1:=DirName;
  2039.    getDir(0, s2);{save current}
  2040.    s1:=GetShortFName(DirName);
  2041.    s1:=StripChar(s1,'"');
  2042.  
  2043.    System.Chdir(s1);
  2044.    if ioresult<>0 then System.Chdir(StripChar(DirName,'"'));
  2045.    if ioresult=0 then begin
  2046.       W32IsDirectory:=True;
  2047.       If Not IsUNC(DirName) then {don't touch UNC names}
  2048.       begin
  2049.         GetDir(0,s1);
  2050.         DirName := GetLongFName(s1); {return s1}
  2051.       end;
  2052.    end;
  2053.    System.Chdir(s2);if ioresult<>0 then;
  2054. End;
  2055. {/////////////////////////////////////////////////////////}
  2056. Function Stupcase(Const s:String):String;
  2057. {convert a string to uppercase}
  2058. Var
  2059. p:pchar;
  2060. i:Word;
  2061. Begin
  2062.     i := length(s)+1;
  2063.     getmem(p, i);
  2064.     strpcopy(p, s);
  2065.     AnsiUpper(p);
  2066.     Stupcase:=StrPas(p);
  2067.     freemem(p, i);
  2068. End;
  2069. {/////////////////////////////////////////////////////////}
  2070. Function IsWin32OS:Boolean;
  2071. {Returns whether we can use 32-bit functions or not}
  2072. Begin
  2073.    IsWin32OS:=Use32Bit;
  2074. End;
  2075. {/////////////////////////////////////////////////////////}
  2076. Function  SetWin32OSValue(Const Enable:Boolean):Boolean;
  2077. {to change Win32stuff on the fly; returns the old value
  2078. of Use32Bit}
  2079. Begin
  2080.     SetWin32OSValue:=Use32Bit; {return old value}
  2081.     If Enable=True then
  2082.     begin
  2083.        If Call32NTError=True then Exit;{Error in Call32NT - don't set}
  2084.        Use32Bit:=True;
  2085.     end
  2086.     else Use32Bit:=False;
  2087. End;
  2088. {/////////////////////////////////////////////////////////}
  2089. {/////////////////////////////////////////////////////////}
  2090. {/////////////////////////////////////////////////////////}
  2091. {////////// initialisation section  //////////////////////}
  2092. {/////////////////////////////////////////////////////////}
  2093. {/////////////////////////////////////////////////////////}
  2094. begin
  2095.   InitialiseWin32;
  2096.   Use32Bit := Call32NTError=False; {any error at all, and we disable all 32-bits}
  2097.   IsWindowsNT := IsWinNT;
  2098.   IsWindows95 :=( (Use32Bit=True) and (IsWindowsNT=False) );
  2099. end.
  2100.