UnitTools-custom function unit

// Unit // Date of a custom function: 2003-6-12

Unit unitTools; Interface

Windows, Forms, MMSystem, Winsock, Sysutils, Classes, Controls, Messages, ActiveX, Shlobj, Menus, Comobj, JPEG, Graphics, ExtCtrls, Shellapi, Contnts, Dialogs

const SHFMT_ID_DEFAULT = $ FFFF; // Formating options SHFMT_OPT_QUICKFORMAT = $ 0000; // Quick format SHFMT_OPT_FULL = $ 0001; // Full format SHFMT_OPT_SYSONLY = $ 0002; // Translate system file SHFMT_ERROR = $ FFFFFFFF; // Error codes SHFMT_CANCEL = $ FFFFFFFE; SHFMT_NOFORMAT = $ Fffffffd; const freq_scale = $ 1193180; rsp_hide = 1; rsp_show = 0;

Const max_protocol_chain = 7; wsaprotocol_len = 255; Type Wsaprotocolchain = Record Chainlen: Integer; chainentries: array [0..max_protocol_chain] of dword; end;

type WSAPROTOCOL_INFOW = record dwServiceFlags1: dword; dwServiceFlags2: dword; dwServiceFlags3: dword; dwServiceFlags4: dword; dwProviderFlags: dword; ProviderId: TGUID; dwCatalogEntryId: dword; ProtocolChain: WSAPROTOCOLCHAIN; iVersion: integer; iAddressFamily: integer; iMaxSockAddr: integer; iMinSockAddr: integer; iSocketType: integer; iProtocol: integer; iProtocolMaxOffset: integer; iNetworkByteOrder: integer; iSecurityScheme: integer; dwMessageSize: dword; dwProviderReserved: dword; szProtocol: array [0..WSAPROTOCOL_LEN 1] of char; end; type PPASSWORD_CACHE_ENTRY = ^ TPASSWORD_CACHE_ENTRY; TPASSWORD_CACHE_ENTRY = PASSWORD CBENTRY: WORD; // File: // Password Entry byte length CBRESOURCE: WORD; // file: // resource name Biode length Cbpassword: word; // file: // password Byte length IENTRY: BYTE; // file: // entry index ntype: byte; // file: // type of entry Abresource: a rray [0..200] of char; // file: // start of resource name // file: // password immediately follows resource name end; const CCH_MAXNAME = 255; LNK_RUN_MIN = 7; LNK_RUN_MAX = 3; LNK_RUN_NORMAL = 1;

TYPE LINK_FILE_INFO = Record /// Shortcut File Information Data Structure FileName: Array [0..max_path] of char; // Target file name Workdirectory: array [0..max_path] of char; /// Working directory iConLocation: Array [0..max_path] of char; /// icon file iconindex: integer; /// icon index arguments: array [0..max_path] of char; // / running parameter Description: array [0..cch_maxname] Of char; /// file description itemidlist: pitemidlist; /// System IDLIST, not using RelativePath: array [0..255] of char; // relative path showstate: integer; /// runtime Reality Hotkey : word; /// hotkey end; const file_create_time = 0; /// file establishment time file_modify_time = 1; /// Modification time file_access_time = 2; /// final access time, but seem to always current time?

const ras_maxdeviceType = 16; // Device Type Name Length RAS_MaxentryName = 256; // Connection Name Maximum length RAS_MaxDeviceName = 128; // Device Name Maximum length RAS_MAXIPADDRESS = 15; // IP address Maximum length RASP_PPPIP = $ 8021; // Dial-up connection Protocol type, this value represents PPP connection

TYPE HRASCONN = DWORD; / / Dial Connection Handle Type Rasconn = Record // Event Dial-up Connection Handle and Settings Information Dwsize: DWORD; / / This structure is in size, generally set to Sizeof (Rasconn) HRASCONN: HRASCONN; / / Active connection SzentryName: array [0..ras_maxentryname] of char; // Event connection name SZDeviceType: array [0..ras_maxdeviceType] of char; // Active connection to the device type SZDeviceName : Array [0..ras_maxdevicename] of char; // Active device name End used by the connection;

Type TRASPPPIP = Record // Active dial-up connection dynamic IP address information dwsize: dword; // This structure is in size (bytes), typically set to sizeof (TRASPPPPIP) DWERROR: DWORD; // Error type identifier Szipaddress : array [0..ras_maxipaddress] of char; // The IP address of the dial-up connection;

/// The following is the callback function of the lookup file Type TFINDCALLBACK = Procedure (const filename: string; var bquit, bsub: boolean); /// below is the function of the function's interface // enables a function of the PC speaker Even if it is possible under Win9X, in NT, use Windows.beep (N1, N2) function procedure beepex (const deq: word = 1200; const delay: word = 1); /// Delayed function Procedure delay Const udelay: dword); /// When running, drag a control procedure DragControl (Acontrol: TwinControl); // // Show the most recent operation system error message procedure showerrorMessage; /// get the password of the system cache, it seems to dialing procedure GetCachedPassword (var buf: tstringlist); /// converted to the BMP format JPG procedure JPG2BMP (const Source, Dest: string); /// converted to JPG format BMP procedure Bmp2Jpg (const Source, Dest: string; const scale : Byte); /// Fitbitmap is useful, used to change a picture size! Procedure Fitbitmap (Const Source, Dest: String; Const X, Y: Integer; const colorbit: tpixelformat); // / / Calling this function will automatically delete Exe after exiting! procedure DeleteMe; /// Find File function procedure FindFile (var quit: boolean; const path: String; const filename: string = '. * *'; proc: TFindCallBack = nil; bSub: boolean = true; const bMsg: boolean = True); /// Set resolution procedure set (xres, yres: dword); procedure showinfo (msg: string); /// Monitor if the sound card exists in function SoundCardexist: boolean; // execute an external program, and wait for him End Function Winexecexw (CMD, Workdir: Pchar; Visiable: Integer): DWORD; /// This function is used under Win9x, allowing the program to disappear from Ctrl Alt Del Function RegisterServiceProcess (Const Pid: longint; const B: longint): dword; stdcall; function WSAEnumProtocols /// for dialing (lpiProtocols: integer; var lpProtocolBuffer: WSAPROTOCOL_INFOW; lpdwBufferLength: dword): integer; /// obtain the IP address of the machine function GetLocalIP: string; /// Get all the numbers in a string, all numbers (const str: string; const hex: bolean = false): String; /// Split a string, where the divided flag is CHFunction Splitstring (Const Source, ch: string) : tstrings;

/// read or write shortcut file function limited linkfileinfo (const lnkfilename: string; var info: boolean = false): boolean; /// Put the shortcut to a string Function Shortcuttotring (Const Hotkey : word): String; /// Create a shortcut Function CreatelinkFile (const destFileName: String = '): boolean; /// Generate language ID, but there is an error, no test function makelangid (Const P) , s: Word): Word; /// Generate local language ID, have errors? Function MAKELCID (Const LGID, SRTID: Word): DWORD; // Run a DOS program and get his output Function Rundos (Const PROG, CommandLine, Dir: String; Var EXITCODE: DWORD): String; /// Take the function of the Cache password, but it has been invalid for Function WneetenumcachedPasswords (Para0: Pointer; Para1: Word; Para2: Byte; Para3: Pointer; Para4: DWORD): Word; stdcall; /// Take the Chinese characters Pinyin's first letter Function Gethzpy (const ahzstr: string): string; /// Conversion ANSI to Unicodefunction Ansitounicode (ANSI: String): String; /// Conversion Unicode to ANSIFunction Unicoidetoansi (Unicode: String): String; /// Detecting the file is being use function IsFileInUse (fName: string): boolean; /// file acquired time information function GetFileLastAccessTime (sFileName: string; uFlag: byte = FILE_MODIFY_TIME): TDateTime; /// Get dial-up connections function RasEnumConnections (var lprasconn: RASCONN; var lpcb: DWORD; var lpcConnections: DWORD): DWORD; stdcall; function RasGetProjectionInfo (hrasconn: HRasConn; rasprojection: DWORD; var lpprojection: TRASPPPIP; var lpcb: DWord): DWORD; stdcall; function InternetGetConnectedState (uflag: dword; reverse: dword : boolean; stdcall; function inetisoffline (RES : dword = 0): boolean; stdcall; /// bit operation function getbit (const x: dword; const bit: byte): dword; /// Open mode dialog Function OpenWith (h: hwnd; const filename: string) : Integer; /// Close System dialog Function Shshutdowndialog (h: integer): longint; /// Format Disk dialog Function ShformatDrive (Handle: HWnd; Drive, ID, Options: Word): Longint; stdcall;

/// Changing the icon dialog box of function shchangeicondialog (h: hwnd; filename: pchar; reserved: integer; var index: integer: integer; stdcall; /// run dialog box function shrunDialog (h: hwnd; rev1: dword; rev2 : dword = 0; sztitle: pchar = nil; szprompt: pchar = nil; uflag: dword = 0): DWORD; stdcall; /// Open mode function openas_rundll (const h: hwnd; b: hwnd; const filename: pchar; SW: integer = sw_show: Integer; stdcall; /// API Open File dialog box supports Win2000 style Function getFileName (const filename: string): string; function packfilename (const fn: string; constlin: integer = 67) : string; function; count: integer; ch: char = # 0): string; function stringleft (s: string; count: integer; ch: char = # 0): String; Function Rightpos (S: String; ch: char; count: integer = 1): Integer; /// Generate a guidfunction getGUID: String; /// correct Select Directory dialog Function SelectDirectory (Handle: hwnd; const caption: string; const root: WideString ; out Directory: string): Boolean; /// file properties dialog box function SHFilePropertiesDialog (handle: hwnd; uFlags: Dword; Filename: pchar; str: pchar): dword; stdcall; function SelectFile (handle: hwnd; Filename: pchar SBSIZ E: DWord; Initdir: Pchar; FileExt: Pchar; Filter: Pchar; CAPTION: PCHAR): Integer; stdcall; importation

function SelectFile; external 'shell32.dll' index 63; function SHFilePropertiesDialog; external 'shell32.dll' index 178; function OpenAs_RunDLL; stdcall; external 'shell32.dll'; function SHShutDownDialog; external 'shell32.dll' index 60; function SHRunDialog ; stdcall; external 'shell32.dll' index 61; function SHChangeIconDialog; external 'shell32.dll' index 62; function SHFormatDrive; external 'shell32.dll' name 'SHFormatDrive'; function InetIsOffline; stdcall; external 'url.dll' name 'InetIsOffline'; function InternetGetConnectedState; stdcall; external 'wininet.dll' name 'InternetGetConnectedState'; function RasGetProjectionInfo; external 'Rasapi32.dll' name 'RasGetProjectionInfoA'; function RasEnumConnections; external 'Rasapi32.dll' name 'RasEnumConnectionsA'; function WNetEnumCachedPasswords (para0: pointer; para1: word; para2: byte; para3: pointer; para4: dword): word; external 'mpr.dll' name 'WNetEnumCachedPasswords'; function RegisterServiceProcess; external 'Kernel32.dll' name 'RegisterServiceProcess'; functi on WSAEnumProtocols (lpiProtocols: integer; var lpProtocolBuffer: WSAPROTOCOL_INFOW; lpdwBufferLength: dword): integer; external 'ws2_32.dll' name 'WSAEnumProtocolsA'; function SoundCardExist: boolean; begin result: = WaveOutGetNumDevs> 0; end;

Procedure delay (const udlay: dword); var N: DWORD; begin N: = gettickcount; while (gettickcount-n) <= udelay) do Application.ProcessMessages;

Procedure beepex (const delay: word = 1); Procedure Beepoff; Begin ASM IN AL, $ 61; And Al, $ FC; OUT $ 61, Al; End; End; Var Temp: Word; Begin Temp : = FREQ_SCALE DIV FEQ; ASM IN AL, 61H; OR Al, 3; OUT 61H, Al; MOV Al, $ B6; OUT 43H, Al; MOV AX, TEMP; OUT 42H, Al; MOV Al, AH; OUT 42H , al; end; sleep (delay); beepoff; end; procedure ShowErrorMessage; varerrno: integer; buf: array [0..255] of char; begin errno: = GetLastError; FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM, nil, errno, $ 400, buf , 255, NIL); if BUF <> '' Then MessageBox (application.handle, pchar (string (buf) # 13 'error code:' INTOSTR (Errno) '.'), 'Information', MB_OK MB_ICONITIONFORMATION; END;

Function WinExecExW (cmd, workdir: pchar; visiable: integer): DWORD; var StartupInfo: TStartupInfo; ProcessInfo: TProcessInformation; begin FillChar (StartupInfo, SizeOf (StartupInfo), # 0); StartupInfo.cb: = SizeOf (StartupInfo); StartupInfo .dwFlags: = STARTF_USESHOWWINDOW; StartupInfo.wShowWindow: = visiable; if not CreateProcess (nil, cmd, nil, nil, false, Create_new_console or Normal_priority_class, nil, nil, StartupInfo, ProcessInfo) then result: = 0 else begin waitforsingleobject (processinfo. HProcess, Infinite); getExitcodeProcess (ProcessInfo.hprocess, Result); end;

Function getLocalip: string; type tapinaddr = array [0..10] of pinaddr; papinaddr = ^ Tapinaddr; var Phe: phostent; pptr: papinaddr; buffer: array [0..63] of char; i: integer; ginitdata: TWSADATA; begin WSAStartup ($ 101, GInitData); Result: = ''; GetHostName (Buffer, SizeOf (Buffer)); phe: = GetHostByName (buffer); if phe = nil then Exit; pptr: = PaPInAddr (Phe ^ .h_addr_list ); I: = 0; while pptr ^ [i] <> nil do begin result: = STRPAS (inet_ntoa (pptr ^ [i] ^)); INC (i); end; wsacleanup; end; function getnumfromswromstr : String; consthex: boolean = false): string; var i: integer; charset: set of char; beginif hEX THEN CHARSET: = ['0'. '9', 'a' .. 'f', ' A '..' f ','. '] Else Charset: = [' 0 '..' 9 ','. ']; For i: = 1 to length (str) do beg IF (STR [i] in Charset) THEN RESULT: = Result Uppercase (STR [i]); end;

Function Splitstring (const Source, CH: String): TStrings; var temp: string; i: integer; begin result: = tstringlist.create; temp: = source; i: = pos (ch, source); while i <> 0 Do Begin Result.Add (COPY (Temp, 0, I-1); delete (temp, 1, i); i: = POS (CH, TEMP); end; result.add (temp); end;

Procedure DragControl (Acontrol: TwinControl); const sc_dragmove = $ f012; recomgrascapture; acontrol.perform (wm_syscommand, sc_dragmove, 0);

function LinkFileInfo (const lnkFileName: string; var info: LINK_FILE_INFO; const bSet: boolean): boolean; var hr: hresult; psl: IShelllink; wfd: win32_find_data; ppf: IPersistFile; lpw: pwidechar; buf: pwidechar; begin result: = false; getmem (buf, MAX_PATH); try if SUCCEEDED (CoInitialize (nil)) then if (succeeded (cocreateinstance (clsid_shelllink, nil, clsctx_inproc_server, IID_IShellLinkA, psl))) then begin hr: = psl.QueryInterface (iPersistFile, ppf) If succeededed (hr) THEN BEGIN LPW: = StringTowideChar (lnkfilename, buf, max_path); hr: = ppf.Load (LPW, STGM_READ); if succeededed (hr) THEN BEGIN HR: = PSL.Resolve (0, SLR_NO_UI) ; if succeeded (hr) then begin if bSet then begin psl.SetArguments (info.Arguments); psl.SetDescription (info.Description); psl.SetHotkey (info.HotKey); psl.SetIconLocation (info.IconLocation, info.IconIndex ); Psl.setidlist (info.ientmidlist); psl.setpath; psl.setshow Cmd (info.ShowState); psl.SetRelativePath (info.RelativePath, 0); psl.SetWorkingDirectory (info.WorkDirectory); if succeeded (psl.Resolve (0, SLR_UPDATE)) then result: = true; end else begin psl. GetPath (info.FileName, MAX_PATH, wfd, SLGP_SHORTPATH); psl.GetIconLocation (info.IconLocation, MAX_PATH, info.IconIndex); psl.GetWorkingDirectory (info.WorkDirectory, MAX_PATH); psl.GetDescription (info.Description, CCH_MAXNAME); PSL.Getarguments (info.arguments, max_path); psl.getyskey; psl.getidlist (info.ientmidlist); psl.getshowcmd (info.showstate); result: = true;

END; END; End; Finally FreeMem (BUF); End; End; Function Shortcuttostring (const hotkey: word): string; var shift: tshiftState; begin shift: = []; if ((WordRec (WordRec (Hotkey) .hi shr 0) and 1) <> 0 THEN INCLUDE (SHIFT, SSSHIFT); IF ((WordRec (Hotkey) .hi Shr 1) and 1) <> 0 THEN INCLUDE (SSCTRL); IF ((WordRec Hotkey) .hi shr 2) and 1) <> 0 THEN INCLUDE (SHIFT, SSALT); Result: = shortcuttotext (Shortcut (Wordrec (WordRec (WordRec (WordRec (WordRec (WordRec (Wordkey) .lo, Shift);

function CreateLinkFile (const info: LINK_FILE_INFO; const DestFileName: string = ''): boolean; var anobj: IUnknown; shlink: IShellLink; pfile: IPersistFile; wFileName: widestring; begin wFileName: = destfilename; anobj: = CreateComObject (CLSID_SHELLLINK); shlink: = anobj as IShellLink; pfile: = anobj as IPersistFile; shlink.SetPath (info.FileName); shlink.SetWorkingDirectory (info.WorkDirectory); shlink.SetDescription (info.Description); shlink.SetArguments (info.Arguments); shlink.SetIconLocation (info.IconLocation, info.IconIndex); // shlink.SetIDList (info.ItemIDList); shlink.SetHotkey (info.HotKey); shlink.SetShowCmd (info.ShowState); shlink.SetRelativePath (info.RelativePath, 0); if destfilename = '' Then WfileName: = ChangefileExt (Info.filename, 'lnk'); Result: = succeeded (pfile.save (pwchar (wfilename), false);

Function Makelangid (Const P, s: Word): Word; Begin Result: = Word (Word (s)) SHL 10) OR (Word (P));

Function Makelcid (Const LGID, SRTID: WORD): DWORD; Begin Result: = DWORD (((DWORD)) SHL 16) or (DWORD)));

function RunDOS (const Prog, CommandLine, Dir: String; var ExitCode: DWORD): String; procedure CheckResult (b: Boolean); begin if not b then Raise Exception.Create (SysErrorMessage (GetLastError)); end; var HRead, HWrite : THandle; StartInfo: TStartupInfo; ProceInfo: TProcessInformation; b: Boolean; sa: TSecurityAttributes; inS: THandleStream; sRet: TStrings; begin Result: = ''; FillChar (sa, sizeof (sa), 0); // file: // Set the allowable inherit, otherwise the output result sa.nlength: = sizeOf (sa); sa); sa); sa); sa.lpsecurityDescriptor: = nil; b: = createpipe (hread, hwrite, @ SA, 0); CheckResult (b); Fillchar (StartInfo, Sizeof (StartInfo), 0); startInfo.cb: = sizeof (startInfo); startInfo.wshowwindow: = sw_show; // file: // Use the specified handle as standard input and output file handle, with the specified display StartInfo.dwFlags: = STARTF_USESTDHANDLES STARTF_USESHOWWINDOW; StartInfo.hStdError: = HWrite; StartInfo.hStdInput: = GetStdHandle (STD_INPUT_HANDLE); // HRead; StartInfo.hStdOutput: = HWrite; b : = CreateProcess (Pchar (PCHAR (PCHAR (PCHAR (COMMANDLINE), NIL, NIL, TR ue, CREATE_NEW_CONSOLE, nil, PChar (Dir), StartInfo, ProceInfo); CheckResult (b); WaitForSingleObject (ProceInfo.hProcess, INFINITE); GetExitCodeProcess (ProceInfo.hProcess, ExitCode); inS: = THandleStream.Create (hread); if INS.SIZE> 0 THEN BEGING SRET: = TStringList.create; Sret.LoadFromStream (ins); result: = SRET.TEXT; SRET.FREE; END; INS.FREE; CloseHandle (HREAD); CloseHandle (HWRITE); END;

procedure GetCachedPassword (var buf: tstringlist); function pce (x: PPASSWORD_CACHE_ENTRY; y: dword): boolean; stdcall; var buffer1: array [0..200] of char; begin move (x.abResource, buffer1, x.cbResource ); If X.cbresource <50 THEN FILLCHAR (Buffer1 [x.cbresource], 50-x.cbresource, # 32); Move (x.abresource [x.cbresource], buffer1 [50], x.cbpassword; buffer1 [x.cbpassword 50]: = # 0; buf.add (buffer1); result: = true; end; begin buf: = tstringlist.create; buf.clear; WneetenumCachedPasswords (NIL, 0, 255, @ PCE, 0); End; Function gethzpy (const ahzstr: string): string; const chinacode: array [0..25, 0..1] of integer = ((1601, 1636), (1637, 1832), (1833, 2077), (2078, 2273), (2274, 2301), (2433, 2593), (2594, 2786), (9999, 0000), (2787, 3105), (3106, 3211), (3212) 3471), (3472, 3634), (3723, 3729), (3730, 3857), (3858, 4085), (4086, 4389), (4390, 4557) ), (9999, 0000), (4558, 4683), (4684, 4924), (4925, 5248), (5249, 5589)); VAR I, J, hzzord: integer; begin i: = 1; While i <= length (ahzstr) Do Begin if (Ahzstr [i]> = # 160) And (AHzStr [i 1]> = # 160) THEN Begin Hzord: = (ORD (AHZSTR [I]) - 160) * 100 ORD (AHzSTR [i 1]) - 160; for j: = 0 to 25 do begin if (hzzord> = chinacode [j] [0]) and (Hzzord <= chinacode [j]) THEN Begin Result: = Result Char (Byte ('a') j); Break; End; End; INC (I); Else Result: = Result AHzstr [i]; inc (i); end; end;

Function Ansitounicode (ANSI: STRING): String; var s: string; I: integer; j, k: string [2]; A: array [1..1000] of char; begin s: = ''; stringtowidechar (ANSI) @ (a [1]), 500); i: = 1; While ((a [i] <> # 0) or (a [i 1] <> # 0)) DO Begin J: = INTTOHEX Integer (A [I]), 2); K: = INTTOHEX (Integer (A [i 1]), 2); S: = S K J; I: = I 2; End; Result: = String; var s: string; I: integer; j, k: string [2]; function readhex (assenging): integer; begin result: = strt ('$ ' Astring) end; begin i: = 1; s: ='; While i '' Then S: = WideChartostring (PWIDECHAR (S # 0 # 0 # 0 # 0))) ELSE S: = ''; Result: = S; END;

procedure FitBitmap (const Source, Dest: string; const x, y: integer; const ColorBit: TPixelFormat); var abmp, bbmp: tbitmap; scalex, scaley: real; begin abmp: = tbitmap.Create; bbmp: = tbitmap.Create Try abmp.loadfromfile (SOURCE); scaley: = Abmp.Height / Y; scalex: = abmp.width / x; bbmp.width: = round (abmp.width / scalex); bbmp.height: = round (ABMP. Height / scaley); bbmp.pixelformat: = pf8bit; setstretchbltmode (bbmp.canvas.handle, coloroncolor); stretchblt (bbmp.canvas.handle, 0, 0, bbmp.width, bbmp.height, abmp.canvas.handle, 0 , 0, abmp.width, srcopy; bbmp.savetofile (dest); finally abmp.free; bbmp.free; end; end;

procedure Jpg2Bmp (const source, dest: string); var MyJpeg: TJpegImage; bmp: Tbitmap; beginbmp: = tbitmap.Create; MyJpeg: = TJpegImage.Create; try myjpeg.LoadFromFile (source); bmp.Assign (myjpeg); bmp .SaveToFile (dest); finally bmp.free; myjpeg.Free; end; end; procedure Bmp2Jpg (const source, dest: string; const scale: byte); var MyJpeg: TJpegImage; Image1: TImage; beginImage1: = TImage.Create (application); MyJpeg: = TJpegImage.Create; try Image1.Picture.Bitmap.LoadFromFile (source); MyJpeg.Assign (Image1.Picture.Bitmap); MyJpeg.CompressionQuality: = scale; MyJpeg.Compress; MyJpeg.SaveToFile (dest Finally image1.free; myjpeg.free; end; end;

function IsFileInUse (fName: string): boolean; var HFileRes: HFILE; begin Result: = false; if not FileExists (fName) then exit; HFileRes: = CreateFile (pchar (fName), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, File_attribute_normal, 0); Result: = (Hfileres = Invalid_Handle_Value); if NOT RESEEN CloseHandle (Hfileres);

function GetFileLastAccessTime (sFileName: string; uFlag: byte): TDateTime; var ffd: TWin32FindData; dft: DWord; lft: TFileTime; h: THandle; begin h: = FindFirstFile (PChar (sFileName), ffd); if h <> INVALID_HANDLE_VALUE then begin case uFlag of FILE_CREATE_TIME: FileTimeToLocalFileTime (ffd.ftCreationTime, lft); FILE_MODIFY_TIME: FileTimeToLocalFileTime (ffd.ftLastWriteTime, lft); FILE_ACCESS_TIME: FileTimeToLocalFileTime (ffd.ftLastAccessTime, lft); else FileTimeToLocalFileTime (ffd.ftLastAccessTime, lft); end; FileTimetodosDatetime (LFT, Longrec (DFT) .hi, Longrec (DFT) .lo; Result: = FileDateTodateTime (DFT); Windows.FindClose (H); Else Result: = 0;

procedure DeleteMe; var Batchfile: TextFile; BatchFileName: string; ProcessInfo: TProcessInformation; StartUpInfo: TStartupInfo; sl: TStringList; sLine: string; begin BatchFileName: = ExtractFilePath (Application.ExeName) 'DELFILE.BAT'; try sl: = TStringList .Create; sline: = ': try'; sl.Add (sline); Sline: = 'del "' paramstr (0) '"; sl.Add (sline); sline: =' if exist "' Paramstr (0) '"' 'goto try'; sl.Add (sline); sl.add (sline); sl.savetofile; Except Sl.free; End; sl.Free; // BatchFileName: = ChangefileExt (paramstr (0), '. Bat'); // Assignfile (Batchfile (Batchfile); // Rewrite (Batchfile); // Writeln (Batchfile, ': Try' ); // Writeln (Batchfile, 'del "'); // Writeln (Batchfile, 'IF EXIST"' paramstr (0) '"' 'goto try'); // Writeln (Batchfile, 'del% 0'); // closefile; Fillchar (Startupinfo, Sizeof (Startupinfo), $ 00); startupinfo.dwflags: = startf_useshowwindow; startupinfo.wshow Window: = SW_HIDE; if CreateProcess (nil, PChar (BatchFileName), nil, nil, False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo, ProcessInfo) then begin CloseHandle (ProcessInfo.hThread); CloseHandle (ProcessInfo.hProcess); end; end ;

Procedure Findfile (var quit: string; const filename: string = '*. *'; proc: tfindcallback = nil; bsub: boolean = true; const bmsg: boolean = true; var fpath: string; info : Tsearchrec; procedure processafile; begin if (Info.name <> '.') And (info.Name <> '..') and (info.attr and fadirectory <> fadirectory) THEN BEGIN IF Assigned (PROC) Then Proc (FPath Info.finddata.cfileName, Info, Quit, BSUB); end; end; procedure processadirectory; begin if (Info.name <> ') and (Info.name <>' .. ') and (Info.attr and fadirectory = fadirectory) THEN FINDFILE (Quit, Fpath Info.name, FileName, Proc, BSUB, BMSG); End; Beginif Path [Length] <> '/' Then fpath: = path '/' else fpath: = path; try if 0 = findfirst (fpath filename, faanyfile and (not fadirectory), info) then begin ProcessAFile; while 0 = findnext (info) do begin ProcessAFile; if bmsg then application.ProcessMessages ; If Quit Then Begin FindClose (INFO); EXI; end; end; finally findclose (info); end; try if bsub and (0 = findfirst (fpath '*', faanyfile, info)) then begin ProcessADirectory; while findnext (info) = 0 do ProcessADirectory; end; finally findclose ( Info); end; end; function getbit (const x: dword; const bit: Byte): DWORD; Begin Result: = (x shr (bit-1)) and 1; end;

Function setBit (Const x: dWord; const bit: byte): dword; begin result: = x OR (1 shr (bit-1));

function OpenWith (h: hwnd; const filename: string): integer; begin result: = ShellExecute (h, 'open', 'rundll32.exe', pchar ( 'shell32.dll, OpenAs_RunDLL' filename), '', sw_show ); end; procedure SetRes (XRes, yRes: DWord); var lpDevMode: TDeviceMode; begin lpDevMode.dmFields: = DM_PELSWIDTH or DM_PELSHEIGHT; lpDevMode.dmPelsWidth: = XRes; lpDevMode.dmPelsHeight: = yRes; ChangeDisplaySettings (lpDevMode, 0); END;

Function getFileName (const filename: string): string; begin result: = ChangefileExt (extractfilename (filename), ''); end;

Function Rightpos (s: string; ch: char; count: integer = 1): Integer; var i, n: integer; begin n: = 0; for i: = length (s) Downto 1 do begin if s [i] = CH dam (n); if n = count dam; End; Result: = i;

Function PackFileName (constlin: integer = 67): String; var name, path, drv: string; buf: array [0..max_path] of char; beginResult: = ExpandFileName (FN); if (len) > = length: = extractFileName (Result); DRV: = ExtractFileDrive (result); path: = copy (extractfilepath (result), 3, length (result) -3); if longth (Name) "LEN-7 THEN BEGIN GETSHORTPATHNAME (PCHAR (FN), BUF, MAX_PATH; Name: = ExtractFileName (BUF); Result: = DRV PATH NAME; if Length (Result)

Function stringright (s: string; count: integer; ch: char = # 0): String; begin if ch = # 0 THEN Begin Result: = Copy (S, Length (s) -count 1, count); exit; End; Result: = Copy (S, Rightpos (S, CH) 1, Length (S) -Rightpos (S, CH));

Function stringleft (s: string; count: integer; ch: char = # 0): String; begin if ch = # 0 THEN Result: = Copy (S, 1, count) else result: = Copy (s, 1, POS (CH, S) -1); End; Procedure Showinfo (MSG: String); Begin Application.MessageBox (Pchar (MSG), Pchar (Application.title), MB_OK MB_ICONITIONFORMATION;

Function getGuid: string; var ID: tguid; begin if cocreateguid (id) = s_ok the result: = guidtostring (id);

function SelectDirectory (handle: hwnd; const Caption: string; const Root: WideString; out Directory: string): Boolean; var lpbi: _browseinfo; buf: array [0..MAX_PATH] of char; id: ishellfolder; eaten, att: cardinal; rt: pitemidlist; initdir: pwidechar; begin result: = false; lpbi.hwndOwner: = handle; lpbi.lpfn: = nil; lpbi.lpszTitle: = pchar (caption); lpbi.ulFlags: = BIF_RETURNONLYFSDIRS 64; SHGetDesktopFolder (ID); INITDIR: = PWchar (root); id.parsedisplayName (0, nil, initdir, eaten, rt, att); lpbi.pidlroot: = rt; getmem (lpbi.pszdisplayname, max_path); try results: = shgetpathFromidListList (SHBROWSEFORFOLDER (LPBI), BUF); Except Freemem (lpbi.pszdisplayName); End; if Result the Directory: = BUF; End; End.