Public library

zhaozj2021-02-16  157

{********************************************************** Name: publicfunc; ***? Author: LYZ 2004-3-17; ******? Function: public function; ******************* *********************************} Unit publicfunc; interface buys? Windows, Math, Sysutils, Classes, Shlobj, ActiveX, Comobj, Registry, DB , Controls, Dialogs, Xmldoc, Xmlintf; Type {TSTREAM Seek Origins}? Tfolderno = (Desktop, StartMenu, Programs); Type? TCPUID? = Array [1..4] of longint;? Tvendor? = Array [0. ? .11] of char; TObjList = class (TList) public ??? destructor Destroy; override; ??? procedure Clear; override; ??? procedure SaveToStream? (stream: TStream); virtual; ??? procedure LoadFromStream ( STREAM: TSTREAM); Virtual ;? End; var? _Decnum: integer;? _RoundValue: double;? _equminvalue: double;? _zerominvalue: double;??? // ************ \ \ (s: string): boolean; // procedure stringWrite (f: file; s: string); // procedure stringRead (f: file; s: string); function slter (s: string): string; function strim (S : String: String; Function S Alltrim (S: String): String; Function SremoveSpace (S: String): String; // Remove space propplitstring (s: string; s1: string; s2: string); procedure ssplitstring1 (s: string; s1: string (Function SINTTOSTRFIX (N: Integer; cnt: integer): string; function around (v: double): double; ??? // seek full function aroundn (v: double; n: integer): double ;? // Reserved several decimal function aequ (v1: double; v2: double): boolean; ??? // Does the two Function Asmall (V1: Double; V2: Double): Boolean ;? File: // V1 v2 function aiszero (v1: double): boolean ;? file: // Judgment is zero function Amax (A : Double; b: double): double ;? file: // Return large value Function Amin (A: Double; B: Double): Double;

File: // Return the small value procedure aswap (P1: Double; P2: Double) ;? File: // Exchange Function IMAX (A: Integer; B: Integer): Integer; File: // Return large value Function IMIN A: integer; b: integer: Integer; file: // Returns a small value procedure iswap (p1: integer; p2: integer) ;? file: // exchange Function RealTostr (V: Double): string; ?? File: // Double Convert to String Function RealToStr1 (V: Double): String; Function Strtoreal (S: String): double ;? file: // String Convert to Double Function Realstr (v: double): string; ??? file: // Double converted into string function realstrn (v: double; dec: integer): string ;? file: // Reserved several decimal Double Double converted to string function realdaten (v: double): string ;? file: // Date transformation Character Function Isdate (const str: str: string): tdatetime ;? file: // Character transformation into date Function RealStr1 (V: Double; Len: Integer; dec: integer): String Function RealStr2 (V: Double; Len: Integer; Function RealStr3 (V: Double; Len: Integer; DEC: Integer): String; Function RealStr4 (V: Double; LEN: Integer; DEC: Integer: String; Functi on StrInt (s: String): Integer; ?? file: // string is converted to integerfile: // xml procedure WriteXMLValue (XML: IXMLNode; Const mc: string; Var Val: string); procedure ReadXMLValue (XML: IXMLNode; Const mc: string; Var Val: string); file: // the following is a data stream stored procedure WriteToStream (stream: TStream; const Number: Integer); overload; procedure WriteToStream (stream: TStream; const Number: Int64); overload; procedure WriteToStream (stream: TStream; const v: Cardinal); overload; procedure WriteToStream (stream: TStream; const v: Word); overload; procedure WriteToStream (stream: TStream; const Filestr: String); overload; procedure WriteToStream (stream: TSTREAM; Const v: double); OVERLOAD; Procedure WrittoTream (Stream: TSTREAM; Const Bool: Boolean); OVERLOAD;

procedure ReadFromStream (stream: TStream; var v: Cardinal); overload; procedure WriteToStream (stream: TStream; const Number: Extended); overload; procedure ReadFromStream (stream: TStream; var v: Extended); overload; procedure ReadFromStream (stream: TStream; var Number: Integer); overload; procedure ReadFromStream (stream: TStream; var Number: Int64); overload; procedure ReadFromStream (stream: TStream; var v: Word); overload; procedure ReadFromStream (stream: TStream; var Filestr: String); overload; procedure ReadFromStream (stream: TStream; var v: Double); overload; procedure ReadFromStream (stream: TStream; var Bool: Boolean); overload; procedure WriteToStream (stream: TStream; const sList: TStringList); overload; procedure ReadFromStream (stream: TStream; var sList: TStringList); overload; procedure WriteToStream (stream: TStream; const iary: array of Integer); overload; procedure ReadFromStream (stream: TStream; var iary: array of Integer); overload; function Strlike (Sou: stri) Ng; key: string): boolean ;? file: // does not include key function sright (s: string; n: integer): string; ????? file: // How many characters are taken on the right Procedure LoadFileList ( Path: String; slist: TStrings; noPath: Boolean); function TimeTicket: Longint; function MonthOfDate (date: TDateTime): Integer; function DayOfDate (date: TDateTime): Integer; function YearOfDate (date: TDateTime): Integer; function GetSplitWord (S: String; Splitc: Char): String; Function HEXTOINT (S: String): Integer; ???????? File: // 16 Entering into 10 Enter Function TransstrByTable (Sou: string; Ori : TStringList; des: TStringList): String; procedure LoadTransTable (fn: String; sou: TStringList; tag: TStringList); function MakeFilePath (s: String): String; function RemoveNote (s: String): String;

function MakePath (path: String): String; function Blone (tj: String; v: String): Boolean; function CodeStr (s: String): String; function DeCodeStr (s: String): String; function GetValueFromStr (vname: String : String; txt: string: boolean; function getPARALIST (txt: string; s: tstringlist): boolean; function SREPLACE (txt: string; Sou: string; tag: string): string; function getosinfo: string ;? ??? File: // NT or Windows 98? Get the current operation platform Function getCurrentUserName: string; file: // Get the current Windows user login procatedure setLink (Folderno: TFolderno; acmdfile, parameter, linkname: string); // create a shortcut function Myrandom (Num: Integer): integer; // time a system generates a random number using a program of the random number range is 0 to Num function GetMouseHwndAndClassName (Sender: TObject): string; function GetMousePosHwndAndClassName (Sender: TPoint) : String; File: // Get the class name and handle of the current mouse location Function getIdediskSerialNumber: string; file: // Take the IDE hard disk serial number function file: // Get the cpuid number Function getcpuid: Tcpuid; Assembler; Register; function getcpuvendor: Tvendor; Assembler; Register; Function Getcpu IDSTR: STRING; {Date field display process, call} Procedure DatefieldText (Sender: Tfield; Var Text: String); {Date type field Enter the judgment function, call} function datefieldsettext (Sender: Tfield) in the ONSETTEXT event} Const text: String): Boolean;? File: // No character function checknullvalue (var key: char): boolean; {Judge the input character is a number} Function CheckinputNum (const isinteger: boolean; astr: string; var) Key: char): Boolean; File: // Get the next number Function? GetNextStrid (const preid: string): string; ?? // preid: = 'lx000000'; importation file: // get the next number Function? GetNextStrid (const preid: string; ?? // preid: = 'lx000000'; var? i, n, n1: ?? INTEGER;? s, s1 :? string ;? c: ???? char; begin ? n: = length (preID) ;? n1: = 0 ;? for i: = n Downto 1 do beg ??? c: = preId [i];

??? i? (ORD (C)> = 65) and (ORD (C) <= 90) THEN BEGIN ?????? N1: = i; ?????? Break; ??? End; • End ;? s: = COPY (preID, 1, n1) ;? S1: = COPY (preID, n1 1, 100) ;? S1: = INTOSTR (Strint (S1) 1) ;? Result: = S1 ; for i: = 1 to? n - n1 - length (s1) do ??? result: = '0' result ;? result: = s result; end; file: // Can't enter Character Function ChecknullValue Var key: char): boolean; const? controlKeyset = [# 13)]; begin? key: = # 0 ;? Result: = true; end; {Judgment Your character is digital} Function CheckinputNum (Const Isinteger : Boolean; astr: string; var key: char): boolean; const? NumberSet = ['0' .. '9', '.', '-'] ;? ControlKeyset = [char (# 8), char ( # 13)]; begin? If key in controlkeyset dam ??? result: = true; ??? exit ;? end;? If not (key in numberset) THEN key: = # 0 ;? f (key = ' . ') AND ((Length (astr) = 0) OR (POS ('. ', astr)> 0)) Then ??? key: = # 0;? file: // Can't you 0? IF (Length (astr) = 1) and (astr [1] = '0') and (key = '0') THEN key: = # 0; file: // Can't there multiple negative? IF (POS ('-', astr)> = 0) AND (key = '-') Then key: = # 0;? If isinteger The begin ??? if key = '.' Then Key: = # 0; // ??? IF (length (astr) = 1) AND (astr [1] = '0') or (key = '.' ) The key: = # 0 ;? End ;? Result: = key <> # 0; end; {Date field display process, call} Procedure DatefieldText (Sender: tfield; var text: string); varing DDATE: TDATE;? Wyear, WMONTH, WDAY: WORD;? Arytestymd: array [1..2] of char; {test input mask Temporary array}? IYMD: Integer; begin? ximd: = 0 ;? DDATE : = Sender.asdatetime ;? decodedate (DDATE, WYEAR, WMONTH, WDAY);

{Test Input Mask All the formats.}? Arytestymd: = 'Year';? If strscan (Pchar (Sender.editmask), Arytestymd [1]) <> nil damd: = 1;? Moon ';? If strscan (Pchar (sender.editmask), Arytestymd [1]) <> nil damd: = 2 ;? arytestymd: =' day '; if strscan (Pchar (sender.editmask), Arytestymd [1 ]) <> nil damd: = 3 ;? Case IYMD OF ??? 1: {Enter Mask is: "YYYY Year" format.} ??? text: = INTOSTOSTOSTR (WYEAR) 'Year';? ?? 2: {Enter Mask is: "YYYY Year MM" format. The input mask is: "YYYY Year MM Month DD Day" format. ??? ELSE {defaults to: "YYYY Years MM Month DD Day" format. Day ';? End; end; {Date field input judgment function, call} function datefieldsettext (Sender: tfield; const text: boolean; var? Ddate: tdate ;? Syear, SMONTH, SDAY: String ;? arytestymd: array [1..2] of char ;? ximd: integer; begin? = 0; {get the date of user input}? Syear: = Copy (Text, 1, 4) ;? Smont: = COPY (Text, 7, 2) ;? SDAY?: = COPY (Text, 11, 2); {Test Try the format included in the mask.}? Arytestymd: = 'year';? If strscan (Pchar (sender.editmask), Arytestymd [1]) <> nil damd: = 1;? ; if strscan (Pchar (Sender.editmask), Arytestymd [1]) <> nil damd: = 2 ;? arytestymd: = 'day'; if strand (pchar (sender.editmask), Arytestymd [1]) <> NIL THEN IYMD: = 3 ;? {Using Try ... Except to input date conversion}? try begin ??? case IYMD OF ????? 1: {Input Mask is: "YYYY Year" format. } ??????? begin ??????? DDATE: = STRTODATE (SYEAR '-01-01');

{Chinese Windows default date format is: yyyy-mm-dd. Under the same} ??????? sender.asdatetime: = ddate; ??????? end; ????? 2: {input The mask is: "YYYY year MM" format.} ??????? begin ??????? ddate: = STRTODATE (SYEAR '-' SMONTH '-01'); ?? ????? sender.asdatetime: = ddate; ??????? end; ????? 3: {input mask is: "YYYY MM Moon DD Day" format.} ???? ??? begin ??????? DDATE: = STRTODATE (SYEAR '-' SMONTH '-' SDAY); ??????? Sender.ASDateTime: = DDATE; ????? ?? End; ????? Else {default is: "YYYY Year MM Month DD Day" format.} ??????? begin ??????? ddate: = stradate (Syear ) ' SMONTH ' - ' SDAY); ??????? sender.asdatetime: = DDATE; ??????? end; ??? end; ??? DatefieldSettext: = true ;? end; • EXCEPT ??? {date conversion error} ??? begin ????? showMessage (pchar (text 'is not a valid date!'))); ????? DatefieldSettext: = false; ??? End; end; end; function GetMouseHwndAndClassName (Sender: TObject): string; varrPos: TPoint; begin Result:? = ''; if boolean (GetCursorPos (rPos)) then Result:? = GetMousePosHwndAndClassName (rPos); end; function GetMousePosHwndAndClassName (Sender : TPOINT): String; var? Hwnd: thandle ;? aname: array [0..255] O O F car ;? Tmpstr: string; begin? tmpstr: = '; hWnd: = windowFromPoint (sender) ;? Tmpstr: =' Handle: ' INTSTR (HWND); if Boolean (GetclassName (hwnd, Aname, 256 )) Then ??? Tmpstr: = 'ClassName:' string (aname)? Else ??? Tmpstr: = 'ClassName: NOT FOUND' ;? RESULT: = TmpStr ;? End; Function Myrandom (Num: Integer): Integer; var? t: _x: integer ;? i: integer; begin? result: = 0 ;? randomize ;? if Num = 0 dam ;? getSystemTime (t) ;? x: = trunc (t. WmilliseConds / 10) * T.WSecond * 1231;? x: = x

Random (1) ;? IF x <0 THEN x: = -x ;? x: = random (x) ;? x: = x mod Num ;? for i: = 0 TO X DO ??? x: = Random (Num) ;? Result: = X; end; function GetCurrentUserName: string; const cnMaxUserNameLen = 254; var sUserName:? string ;? dwUserNameLen:? Dword; begin dwUserNameLen: = cnMaxUserNameLen-1 ;? SetLength (sUserName, cnMaxUserNameLen)? ?; GetUserName (Pchar (sUserName), dwUserNameLen) ;? SetLength (sUserName, dwUserNameLen) ;? Result: = sUserName; end; Procedure SetLink (FolderNo: TFolderNo; ACmdFile, Parameter, LinkName: string);? var MyObject: Iunknown; ? MySLink: IShellLink ;? MyPFile: IPersistFile ;? FileName: string ;? Directory: string ;? WFileName: WideString ;? MyReg: TRegIniFile ;? tmpFolderNo: string; begin if FolderNo = Desktop then tmpFolderNo:? = 'Desktop' ;? if FolderNo = StartMenu then tmpFolderNo: = 'StartMenu' ;? if FolderNo = Programs then tmpFolderNo: = 'Programs'; ??? MyObject:? = CreateComObject (CLSID_ShellLink) ;? MySLink: = MyObject as IShellLink ;? MyPFile: = MyObject as ipersistfi Le ;? filename: = acmdfile ;? with myslink do? begin ??? setarguments (Pchameter)); ??? setPath (Pchar (filename)); ? end ;? MyReg: = TRegIniFile.Create ( 'Software / MicroSoft / Windows / CurrentVersion / Explorer'); Directory:? = MyReg.ReadString ( 'Shell Folders', tmpFolderNo, '') ;? file: // createDir ( Directory; = Directory '/' linkname '.lnk' ;? mypfile.save (pwchar (wfilename), false) ;? myreg.free; end; function getosinfo: string; var? Vi: TosversionInfo Begin? result: = ';? vi.dwosversioninfosize: =

SizeOf (VI); GetversionEx (VI); // Get the version of the WINDEOWS and WIN32 operating system that is running //? Vi.dwplatformid? Result: = result format ('% D% D% D', [VI. dwMajorVersion, VI.dwMinorVersion, VI.dwBuildNumber]) ;? Result: = Result GetIdeDiskSerialNumber GetCPUIDStr ;? case Win32Platform of ??? VER_PLATFORM_WIN32_WINDOWS: Result: = Result 'Windows 95/98'; ??? VER_PLATFORM_WIN32_NT: Result: = Result 'Windows NT' ;? Else ??? Result: = Result 'Windows32' ;? End; End; function getcpuid: tcpuid; assembler; register; asm? Push ??? EBX ??????? ? {Save affected register}? Push ??? EDI? MOV ???? EDI, EAX ???? {@resukt}? MOV ???? Eax, 1? Dw ????? $ A20F??? ??? {cpuid command}? Stosd ???????????? {cpuid [1]}? MOV ???? EAX, EBX? Stosd ???????????? ?? {cpuid [2]}? MOV ???? eax, ECX? Stosd ?????????????? {cpuid [3]}? MOV ???? Eax, EDX? Stosd ?????????????? {cpuid [4]}? POP ???? eDi ????? {restore registers}? Pop ???? ebxend; function getcpuvendor: tvector; assembler Register; asm? push ??? EBX ????? {save affected register}? push ??? EDI? MOV ???? EDI, EAX ??? {@RESULT (tven DOR)}? MOV ???? eax, 0? dw ????? $ A20F ???? {cpuid command}? MOV ???? EAX, EBX? XCHG ?? EBX, ECX ???? { SAVE ECX RESULT}? MOV ??? ECX, 4 @ 1 :? stosb? shr ???? eax, 8? loop ??? @ 1? MOV ???? EAX, EDX? MOV ??? ECX, 4 @ 2 :? stosb? Shr ???? eax, 8? Loop ??? @ 2? MOV ???? EAX, EBX? MOV ??? ECX, 4 @ 3 :? stosb? Shr ???? eax , 8? Loop ???? EDI ????? {restore registers}? POP ???? ebxend; function getcpuidstr: string; var? Cpuid: tcpuid ;? i ???? : Integer ;? s ???: tvendor; begin? Result: = ';? For i: = low (cpuid) to high (cpuid)? Do cpuid [i]: = -1; ??? cpuid ?: = Getcpuid ;? result: = Result INTTOHEX (CPUID [1], 8);? Result: = Result

INTTOHEX (CPUID [2], 8);? Result: = Result INTTOHEX (CPUID [3], 8) ;? Result: = Result INTTOHEX (CPUID [4], 8) ;? S: = getcpuvendor ;? Result : = Result S; End; Function GetidiskSerialNumber: String ;? File: // Take IDE Hard Drive Serial Number Function? Type ??? Tsrbiocontrol = Packed Record ??? HeaderLength: ulong; ??? Signature: Array [0 .. 7] of char; ??? Timeout: ulong; ??? ReturnCode: ulong; ??? length: ulong ;???? S u_;? P = Tsrbiocontrol ;? psrbiocontrol = ^ TsrbioControl;? Tsrbiocontrol;? TIDEREGS = packed record ??? bFeaturesReg: Byte; // Used for specifying SMART "commands" ??? bSectorCountReg:. Byte; // IDE sector count register ??? bSectorNumberReg: Byte; // IDE sector number register ??? bCylLowReg: Byte; // IDE Low Order Cylinder Value ??? bcylhighreg: Byte; // Ide High Order Cylinder Value ??? bdriveheadreg: Byte; // Ide Drive / Head Register ??? bcommandreg: Byte; // Actual IDE Command. ??? breserved: Byte; // reserved. Must be zero.? end ;? idregs = TIDEREGS;? pidegegg = ^ TIDEREGS;? tsendcmdinpar AMS = PACKED RECORD ??? CBuffersize: dword; ??? IrdriveRegs: TideRegs; ??? bdrivenumber: byte; ??? breserved: array [0..2] of byte; ??? dwreserved: array [0 .. 3] of DWORD; ??? bBuffer: Array [0..0] of Byte ;? end ;? SENDCMDINPARAMS = TSendCmdInParams ;? PSendCmdInParams = ^ TSendCmdInParams; TIdSector = packed record ??? wGenConfig:? Word; ??? wNumCyls : Word; ??? wnumheads: word; ??? wbytespers: word; ??? wbytespector: word; ??? Wsectorspertrack: word; ??? Wvendorunique: array [0..2] Of word; ??? sSerialnumber: array [0..19] of char; ??? wbuffertype: word; ??? wbuffersize: word; ??? sfirmwarerev: array [0..7 ] of char;

??? SMODELNUMBER: Array [0..39] of char; ??? wmorevendorunique: word; ??? wdoublewordio: word; ??? wcapabilities: word; ??? WRESERVED1: WORD; ??? wpiotiming: word; ??? wDMATiming: Word; ??? wBS: Word; ??? wNumCurrentCyls: Word; ??? wNumCurrentHeads: Word; ??? wNumCurrentSectorsPerTrack: Word; ??? ulCurrentSectorCapacity: ULONG; ??? wMultSectorStuff: Word ;? ?? ultotaraddressablecturectors: ulong; ??? wsinglewordddma: word; ??? wmultiwordddma: word; ??? breserved: array [0..127] of byte ;? end ;? pidsector = ^ tidsector; const? IDE_ID_Function = $ EC ;? IDENTIFY_BUFFER_SIZE = 512 ;? DFP_RECEIVE_DRIVE_DATA = $ 0007c088 ;? IOCTL_SCSI_MINIPORT = $ 0004d008 ;? IOCTL_SCSI_MINIPORT_IDENTIFY = $ 001b0501 ;? DataSize = sizeof (TSendCmdInParams) -1 IDENTIFY_BUFFER_SIZE ;? BufferSize = SizeOf (SRB_IO_CONTROL) DataSize ;? W9xBufferSize = IDENTIFY_BUFFER_SIZE 16; var? HDevice: thandle ;? cbbytesreturned: dWord ;? Pindata: psendcmdinparams ;? poutdata: pointer; // psendcmdoutparams? Buffer: array [0..buffersize-1] of byte ; srbcontrol: TsrbioControl absolute buffer;? procedure changeberteorder (var data; size: integer) ;? var ??? ptr: pchar; ??? i: integer; ??? c: char ;? begin ??? PTR: = @Data; ??? for i: = 0 to (size shr 1) -1 do beg ????? c: = ptr ^; ????? ptr ^: = (PTR 1) ^;? ???? (PTR 1) ^: = C; ????? INC (PTR, 2); ???? End ;? end; begin? result: = '';? Fillchar (buffer, buffersize, # 0) ;? if Win32Platform = VER_PLATFORM_WIN32_NT then begin // Windows NT, Windows 2000 // Get SCSI port handle ??? hDevice: = CreateFile ( '//./Scsi0:',GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE ,? ???????????????????????? nil, open_existing, 0, 0);

??? if hdevice = invalid_handle_value thr; ??? Try ????? SRBControl.HeaderLength: = SIZEOF (SRB_IO_CONTROL); ????? system.move ('Scsidisk', SRBControl.Signature, 8) ;? ???? SRBControl.Timeout: = 2; ????? SRBControl.Length: = DATASize; ????? SRBControl.controlcode: = ioctl_scsi_miniport_identify; ????? Pindata: = psendcmdinparams (Pchar (@Buffer) SIZEOF (SRB_IO_CONTROL)); ????? poutdata: = pindata; ???????????? CBuffersize: = Identify_buffer_size; ??????? bdrivenumber: = 0 ; ????????????????? bfeaturesreg: = 0; ????????? bsectorcountreg: = 1; ????????? bsectornumberreg : = 1; ????????? bcyllowreg: = 0; ????????? bcylhighreg: = 0; ????????? bdriveheadreg: = $ A0; ??? ?????? bcommandreg: = IDE_ID_FUNCTION; ??????? End; ????? end; ????? ioctl_scsi_miniport, ????? @buffer, buffersize, @Buffer, buffersize, ????? cbbytesreturned, nil), then, "??? finally ????? closehandle (HDEVICE); ??? end ;? end else begin // windows 95 osr2, windows 98 ?? ? HDevice: = CreateFile ('//./smartvsd', 0, 0, nil, create_new, 0, 0); ??? if hdevice = invalid_handle_value thr; ??? Try ????? Pindata: = psendcmdinparams @Buffer); ????? poutdata: = @pindata ^ .bbuffer; ????? with pindata ^ do beg ??????? cbuffersize: = Identify_buffer_size; ??????? bdrivenumber: = 0; ??????? with irdriveRegs do beg ????????? bfeatureSreg: = 0; ????????? bsectorcountreg: = 1; ????????? Bsectornumberreg: = 1; ????????? bcyllowreg: = 0; ?????????? bcylhighreg: = 0; ????????? bdriveheadreg: = $ A0; ?? ??????? bcommandreg: = IDE_ID_FUNCTION; ??????? End; ?????

????? if not deviceioControl (HDEvice, DFP_RECEIVE_DRIVE_DATA, ??????????? Pindata, SizeOf (Tsendcmdinparams) -1, Poutdata, ??????????? W9xBuffersize, CbbytesReturned, NIL) THEN EXIT; ??? finally ????? closehandle (hdevice); ??? End ;? end ;? with pidsector 16) ^ Do Begin ??? Changebyteorder (sSerialNumber, Sizeof) sSerialNumber)); ??? SetString (Result, sSerialNumber, SizeOf (sSerialNumber)) ;? end; end; procedure TObjList.Clear; begin inherited;? end; destructor TObjList.Destroy; begin inherited;? end; function StrIsEmpty (s : Bolean; begin? Result: = false ;? if s = '' 'THEN ??? Result: = true; end; {procedure stringwrite (file; s: string); Begund; Procedure StringRead (f); Procedure StringRead (f: File; s:?} Function Sltrim (s: string): string; beginend; function strim (s: string): string; beginend; function SallTrim (s: string): string; beginend; function SremoveSpace S: string; string; var? i ????: integer ;? count: integer; begin? result: = ';? count: = length (s) ;? for i: = 1 to count do b EGIN ??? IF S [I] <> 'Then Begin ????? result?: = Result S [I]; ??? End ;? end; end; procedure ssplitstring (s: string; s1: String; s2: string; string; s: string; s1: string; s2: string; beginnd; function sinttostrfix (n: integer; cnt: integer): string; beginend; function around (v: double) : Double; begin? Result: = round (v); end; function aroundn (v: double; n: integer): double; var? I ??: integer; begin? Result: = v ;? for i: = 0 TO N - 1 Do Begin ??? Result: = Result * 10 ;? End ;? Result: = ROUND (result) ;? for i: = 0 to n - 1 do beg ??? Result: = Result / 10; End; end; function aequ (v1: double; v2: double): boolean

Begin? Result: = false ;? if v1 = v2 Then ??? Result: = truend; function asmall (v1: double; v2: double): boolean; begin? result: = false ;? IF v1 = b THEN??? Result: = a? Else ??? Result: = B; End; function amin (A: Double; B: double): double; begin? if a> = b THEN ??? Result: = b? Else ??? Result: = a; end; procedure aswap (p1: double; p2: double); begin end; function imax (a: integer; b: integer): integer; begin? if a> = b Then ?? Result: = a Else ?? Result: = B; End; Function IMIN (A: Integer; B: Integer): Integer; Begin? IF a> = b Then ?? Result: = B? Else ?? Result: = a; end; Procedure iswap (p1: integer; p2: integer); begin end; function realtostr (v: double): string; begin? result: = floattostr (v); end; funct ION realTOSTR1 (V: Double): String; BeGinend; Function Strtoreal (s: string): double; var? i: integer ;? b: boolean; begin? b: = true ;? result: = 0 ;? for i: = 1 to Length (s) do beg ??? IF (ORD (S [i])> 57) OR (ORD (S [i]) <48) THEN BEGIN ????? IF ORD (S [i] <> 46 THEN BEGIN ??????? b: = false; ??????? Break; ????? end; ??? end ;? end;? F i a (length (s) <> 0) THEN ??? Result: = struploat (s) end; function realstr (v: double): string; begin? Result: = floattostr (v); end; function floattofloat (const d: double; const n : Integer: Double; var? i ??: integer ;? max: longint; begin? max: = 1 ;? for i: =

1 to n do begin ??? Max: = max * 10 ;? end ;? result: = D * max ;? result: = round (result) ;? result: = results / max; end; function realstn (V: Double; dec: integer: string; var? Td: double; begin? Td: = floattofloat (v, dec) ;? Result: = floattostr (TD); end; function realdaten (V: double): string; var? Year, Month, Day: Word; Begin? Decodedate (V, Year, Month, day);? Result: = INTOSTR (year) 'Year' INTOSTR (MONTH) 'Moon' INTOSTR (DAY) 'Day '; End; Function isdate (const str: string): boolean; begin? try ??? strtodate (str) ;? eXcept ??? result: = false; ??? exit ;? end ;? result: = true; End; Function getdate (const str: string): tdatetime; var? newstr: string; begin? newstr: = str ;? newstr: = StringReplace (newstr, 'year', '-', []); newstr: = StringReplace (newstr, 'month', '-', []); newstr: = stringreplace (newstr, 'day', '', []); if isdate (newstr) Then Result: = STRTODATE (NEWSTR)? Else Result: = SYSUTILS.DATE; END; FUNCTION RealStr1 (V: Double; LEN: Integer; dec: integer): string; begin? end; function realst2 (v: double; En: integer; becomuend; function realstr3 (V: Double; Len: integer; dec: integer): string; beginnd; function realstr4 (v: double; len: integer; dec: integer): String BeGinend; Function strint (s: string): Integer; var? i: integer ;? b: boolean; begin? b: = true ;? result: = 0 ;? if s = '' Then Begin ??? Result: = 0; ??? EXIT;? End ;? for i: = 1 to length (s) do beg ??? IF (ORD (S [I])> 57) OR (ORD (S [I]) <48 ) The begin ?????? B: = false; ????? Break; ??? end ;? end;? IF b and (length (s) <> 0) THEN ??? Result: = start ( s) end;

procedure WriteXMLValue (XML: IXMLNode; Const mc: string; Var Val: string);? var Child_Node: IXMLNode; begin Child_Node:? = XML.AddChild (mc) ;? Child_Node.Text: = Val; end; procedure ReadXMLValue (XML : Ixmlnode; const mc: string; var? Child_node: ixmlnode; begin? Child_node: = xml.childNodes.first ;?? (Child_node.nodeename = mc) THEN ??? Val: = child_node.text ; end; procedure ReadFromStream (Stream: TStream; var Bool: Boolean); begin Stream.Read (Bool, SizeOf (Bool)); end; procedure ReadFromStream? (Stream: TStream; var Number: integer);? begin Stream.Read (Number, SizeOf (Number)); end; procedure ReadFromStream (stream: TStream; var Number: Int64); overload; begin Stream.Read (Number, SizeOf (Number)); end; procedure ReadFromStream (Stream:? TStream; var FILESTR: STRING); var? Count: integer ;? i: integer ;? s: char; begin? Filestr: = ';? Count: = 0 ;? readfromstream (stream, count) ;? for i: = 1 to Count do beg ??? stream.read (s, 1); ??? filestr: = filestr s; end; end; procedure Writtost ream (Stream: TStream; const Number: integer); begin Stream.Write (Number, SizeOf (Number)); end; procedure WriteToStream? (stream: TStream; const Number: Int64);? overload; begin Stream.Write (Number , SIZEOF (NUMBER); end; file: // Write the FileSTR WrittoTream (Stream: TSTREAM; Const fileStr: string); var? Count: integer ;? i: integer ;? s: char; begin? Count: = Length (filestr) ;? WrittoTream (stream, count);? For i: = 1 to count do beg ??? s: = filestr [i]; ??? stream.write (s, 1);? end; end; procedure WriteToStream (stream: TStream; const Number: Extended); overload; begin stream.Write (Number, SizeOf (Number)); end; procedure ReadFromStream? (stream: TStream; var v: Extended); overload;

begin Stream.Read (v, SizeOf (v)) ;? end; procedure WriteToStream? (Stream: TStream; const Bool: Boolean);? begin Stream.Write (Bool, Sizeof (Bool)); end; procedure WriteToStream (stream : TStream; const v: Cardinal); overload; beginend; procedure WriteToStream (stream: TStream; const v: Word); overload; beginend; procedure WriteToStream (stream: TStream; const v: Double); overload; begin stream.Write? (V, sizeof (V)); end; procedure ReadFromStream (stream: TStream; var v: Cardinal); overload; beginend; procedure ReadFromStream (stream: TStream; var v: Word); overload; beginend; procedure ReadFromStream (stream: TStream; var v: Double); overload; begin Stream.Read (V, sizeof (v)); end; procedure WriteToStream (stream:? TStream; const sList: TStringList); overload; beginend; procedure ReadFromStream (stream: TStream; var sList: TStringList); overload; beginend; procedure WriteToStream (stream: TStream; const iary: array of Integer); overload; beginend; procedure ReadFromStream (stream: TStream; var iary: array Overload; becomes; function strlike (Sou: string; key: string): boolean; begin? result: = false;? i i (sou, key)> 0 THEN ??? = true; end; Function Sright (s: string; n: integer): string; var? i ??: integer; begin? result: = ';? for i: = 1 to n do beg ??? Result: = Result s [ I] ;? end; end; procedure LoadFileList (Path: String; slist: TStrings; noPath: Boolean); beginend; function TimeTicket:? Longint; begin Result: = 0; end; function MonthOfDate (date: TDateTime): Integer; Begin? result: = 0; end; function dayofdate: integer; begin? result: = 0; end; function yearofdate (date: tdatetime): integer; begin? result: = 0; end; function getSplitword String;

转载请注明原文地址:https://www.9cbs.com/read-8284.html

New Post(0)