delphi的一个公用函数库

{**********************************************
***? Name: PublicFunc;
***? Author: lyz 2004-3-17;
***
***? Function: 公共函数；
**********************************************}
unit PublicFunc;

interface

uses
? 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;


?

?

//*************LYZ
function StrIsEmpty (s: String): Boolean;

//procedure StringWrite (f: file; s: String);

//procedure StringRead (f: file; s: String);

function SLtrim (s: String): String;

function STrim (s: String): String;

function SAllTrim (s: String): String;

function SRemoveSpace (s: String): String;//除掉空格

procedure SSplitString (s: String; s1: String; s2: String);

procedure SSplitString1 (s: String; s1: String; s2: String);

function SIntToStrFix (n: Integer; cnt: Integer): String;

function ARound (v: Double): Double;?? //求整

function ARoundN (v: Double; n: Integer): Double;? //保留几位小数

function AEqu (v1: Double; v2: Double): Boolean;??? //两个是否相等

function ASmall (v1: Double; v2: Double): Boolean;? file://v1 < v2

function ABig (v1: Double; v2: Double): Boolean;??? file://v1 > v2

function AIsZero (v1: Double): Boolean;? file://判断是否为零

function AMax (a: Double; b: Double): Double;? file://返回大值

function AMin (a: Double; b: Double): Double;? file://返回小值

procedure ASwap (p1: Double; p2: Double);? file://交换

function IMax (a: Integer; b: Integer): Integer; file://返回大值

function IMin (a: Integer; b: Integer): Integer; file://返回小值

procedure ISwap (p1: Integer; p2: Integer);? file://交换

function RealToStr (v: Double): String;?? file://Double转换成String

function RealToStr1 (v: Double): String;

function StrToReal (s: String): Double;? file://String转换成Double

function RealStr (v: Double): String;??? file://Double转换成String

function RealStrN (v: Double; dec: Integer): String;? file://保留几位小数 Double转换成String

function RealDateN(v: Double): String;? file://日期转化成字符

function IsDate(const str: string): Boolean;

function GetDate(const str: string): TDateTime;? file://字符转化成日期

function RealStr1 (v: Double; len: Integer; dec: Integer): String;

function RealStr2 (v: Double; len: Integer; dec: Integer): String;

function RealStr3 (v: Double; len: Integer; dec: Integer): String;

function RealStr4 (v: Double; len: Integer; dec: Integer): String;

function StrInt (s: String): Integer;?? file://string 转换成 integer
file://xml

procedure WriteXMLValue(XML : IXMLNode; Const mc : string; Var Val: string);

procedure ReadXMLValue(XML : IXMLNode; Const mc : string; Var Val: string);

file://以下是保存为数据流
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 WriteToStream (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: String; key: String): Boolean;? file://sou中是否包括key

function SRight (s: String; n: Integer): String;????? file://取右边多少个字符

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进制转换成10进制

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; s: String; txt: String): Boolean;

function GetParaList (txt: String; ss: TStringList): Boolean;

function SReplace (txt: String; sou: String; tag: String): String;

Function GetOSInfo: String;???? file://NT 还是 Windows 98?取得当前操作平台

function GetCurrentUserName : string; file://获取当前Windows用户的登录名

Procedure SetLink(FolderNo: TFolderNo; ACmdFile,Parameter,LinkName: string);//创建快捷方式

function Myrandom(Num: Integer): integer;//一个利用系统时间产生随机数的程序该随机数的范围是0到Num

function GetMouseHwndAndClassName(Sender: TObject): string;

function GetMousePosHwndAndClassName(Sender: TPoint): string; file://获取当前鼠标位置的类名和句柄

function GetIdeDiskSerialNumber : String;? file://取Ide硬盘序列号函数

file://得到CpuID号
function GetCPUID : TCPUID; assembler; register;

function GetCPUVendor : TVendor; assembler; register;

function GetCPUIDStr: String;

{日期型字段显示过程,在OnGetText事件中调用}
procedure DateFieldGetText(Sender: TField; var Text: String);

{日期型字段输入判断函数,在OnSetText事件中调用}
function DateFieldSetText(Sender: TField; const Text: String):Boolean;


? file://不能输入字符
function CheckNullValue(var Key: Char): Boolean;
{判断输入的字符是否是数字}
function CheckInputNum(const IsInteger: Boolean; AStr: string; var Key: Char): Boolean;

file://得到下一编号
function? GetNextStrId(const PreId: string): string;?? // preId := ‘LX000000‘;

implementation

file://得到下一编号
function? GetNextStrId(const PreId: string): 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 begin
??? c := PreId[I];
??? if? (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 := IntToStr(StrInt(s1) + 1);
? result := s1;
? for I := 1 to? n - n1 - Length(s1) do
??? Result := ‘0‘ + Result;
? result := s + Result;
end;

file://不能输入字符
function CheckNullValue(var Key: Char): Boolean;
const
? ControlKeySet = [Char(#13)];
begin
? Key := #0;
? Result := True;
end;

{判断输入的字符是否是数字}
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 then begin
??? Result := True;
??? Exit;
? end;

? if not (Key in NumberSet) then Key := #0;
? if (Key = ‘.‘) and ((Length(AStr) = 0) or (Pos(‘.‘,AStr) > 0)) then
??? Key := #0;

? file://不能前两个同时为0
? if (Length(AStr) = 1) and (AStr[1] = ‘0‘) and (Key = ‘0‘) then Key := #0;

? file://不能有多个负号
? if (Pos(‘-‘,AStr) >= 0) and (Key = ‘-‘) then Key := #0;

? if IsInteger then begin
??? if key = ‘.‘ then Key := #0;
//??? if (Length(AStr) = 1) and (AStr[1] = ‘0‘) or (Key = ‘.‘) then Key := #0;
? end;
? Result := Key <> #0;
end;

{日期型字段显示过程,在OnGetText事件中调用}
procedure DateFieldGetText(Sender: TField; var Text: String);
var
? dDate: TDate;
? wYear,wMonth,wDay: Word;
? aryTestYMD: Array [1..2] of Char ;{测试输入掩码用临时数组}
? iYMD: Integer;
begin
? iYMD := 0;
? dDate:= Sender.AsDateTime;
? DecodeDate(dDate,wYear,wDay);
? {测试输入掩码所包含的格式.}
? aryTestYMD:= ‘年‘;
? if StrScan(PChar(Sender.EditMask),aryTestYMD[1]) <> nil then iYMD:= 1;
? aryTestYMD:= ‘月‘;
? if StrScan(PChar(Sender.EditMask),aryTestYMD[1]) <> nil then iYMD:= 2;
? aryTestYMD:= ‘日‘;
? if StrScan(PChar(Sender.EditMask),aryTestYMD[1]) <> nil then iYMD:= 3;
? case iYMD of
??? 1:{输入掩码为:”yyyy年”的格式.}
??? Text:= IntToStr(wYear) + ‘年‘;
??? 2: {输入掩码为:”yyyy年mm月”的格式.}
??? Text:= IntToStr(wYear) + ‘年‘ + IntToStr(wMonth) + ‘月‘;
??? 3: {输入掩码为:”yyyy年mm月dd日”的格式.}
??? Text:= IntToStr(wYear) + ‘年‘ + IntToStr(wMonth) + ‘月‘ + IntToStr(wDay) + ‘日‘;
??? else {默认为:”yyyy年mm月dd日”的格式.}
??? Text:= IntToStr(wYear) + ‘年‘ + IntToStr(wMonth) + ‘月‘ + IntToStr(wDay) + ‘日‘;
? end;
end;

{日期型字段输入判断函数,在OnSetText事件中调用}
function DateFieldSetText(Sender: TField; const Text: String):Boolean;
var
? dDate: TDate;
? sYear,sMonth,sDay: String;
? aryTestYMD: Array [1..2] of Char;
? iYMD: Integer;
begin
? iYMD := 0;
{获得用户输入的日期}
? sYear := Copy(Text,1,4);
? sMonth:= Copy(Text,7,2);
? SDay? := Copy(Text,11,2);
{测试输入掩码所包含的格式.}
? aryTestYMD := ‘年‘;
? if StrScan( PChar(Sender.EditMask),aryTestYMD[1] ) <> nil then iYMD := 1;
? aryTestYMD := ‘月‘;
? if StrScan( PChar(Sender.EditMask),aryTestYMD[1] ) <> nil then iYMD := 2;
? aryTestYMD := ‘日‘;
? if StrScan( PChar(Sender.EditMask),aryTestYMD[1] ) <> nil then iYMD := 3;
? {利用Try…Except进行输入的日期转换}
? try begin
??? case iYMD of
????? 1: {输入掩码为:”yyyy年”的格式.}
??????? begin
??????? dDate := StrToDate( sYear + ‘-01-01‘ );{中文Windows默认的日期格式为:yyyy-mm-dd.下同}
??????? Sender.AsDateTime := dDate;
??????? end;
????? 2: {输入掩码为:”yyyy年mm月”的格式.}
??????? begin
??????? dDate := StrToDate( sYear + ‘-‘ + sMonth + ‘-01‘ );
??????? Sender.AsDateTime:=dDate;
??????? end;
????? 3: {输入掩码为:”yyyy年mm月dd日”的格式.}
??????? begin
??????? dDate := StrToDate( sYear + ‘-‘ + sMonth + ‘-‘ + sDay );
??????? Sender.AsDateTime := dDate;
??????? end;
????? else {默认为:”yyyy年mm月dd日”的格式.}
??????? begin
??????? dDate := StrToDate( sYear + ‘-‘ + sMonth + ‘-‘ + sDay );
??????? Sender.AsDateTime := dDate;
??????? end;
??? end;
??? DateFieldSetText := True;
? end;
? except
??? {日期转换出错}
??? begin
????? showmessage( PChar ( Text + ‘不是有效的日期!‘));
????? DateFieldSetText := False;
??? end;
end;

end;


function GetMouseHwndAndClassName(Sender: TObject): string;
var
rPos: TPoint;
begin
? Result := ‘‘;
? if boolean(GetCursorPos(rPos)) then Result := GetMousePosHwndAndClassName(rPos);
end;

function GetMousePosHwndAndClassName(Sender: TPoint): string;
var
? hWnd: THandle;
? aName: array [0..255] of char;
? tmpstr: string;
begin
? tmpstr := ‘‘;
? hWnd := WindowFromPoint(Sender);
? tmpstr := ‘Handle : ‘ + IntToStr(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: _SystemTime;
? X: integer;
? I: integer;
begin
? Result := 0;
? Randomize;
? If Num = 0 then Exit;
? 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,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 IPersistFile;
? FileName := ACmdFile;
? with MySLink do
? begin
??? SetArguments(Pchar(Parameter));
??? SetPath(Pchar(FileName));
??? SetWorkingDirectory(Pchar(ExtractFilePath(FileName)));
? end;
? MyReg := TRegIniFile.Create(‘Software/MicroSoft/Windows/CurrentVersion/Explorer‘);

? Directory := MyReg.ReadString(‘Shell Folders‘,tmpFolderNo,‘‘);
? file://CreateDir(Directory);
? WFileName := 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);//取得正在运行的Windeows和Win32操作系统的版本

//? 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???? EBX
end;

function GetCPUVendor : TVendor; assembler; register;
asm
? PUSH??? EBX???? {Save affected register}
? PUSH??? EDI
? MOV???? EDI,EAX?? {@Result (TVendor)}
? 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??? @3
? POP???? EDI???? {Restore registers}
? POP???? EBX
end;

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 GetIdeDiskSerialNumber : String;? file://取Ide硬盘序列号函数
? type
??? TSrbIoControl = packed record
??? HeaderLength : ULONG;
??? Signature : Array[0..7] of Char;
??? Timeout : ULONG;
??? ControlCode : ULONG;
??? ReturnCode : ULONG;
??? Length : ULONG;
? end;
? SRB_IO_CONTROL = TSrbIoControl;
? PSrbIoControl = ^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;
? IDEREGS = TIDERegs;
? PIDERegs = ^TIDERegs;

? TSendCmdInParams = 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;
??? wReserved : Word;
??? wNumHeads : Word;
??? wBytesPerTrack : Word;
??? wBytesPerSector : Word;
??? wSectorsPerTrack : Word;
??? wVendorUnique : Array[0..2] of Word;
??? sSerialNumber : Array[0..19] of Char;
??? wBufferType : Word;
??? wBufferSize : Word;
??? wECCSize : 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;
??? ulTotalAddressableSectors : ULONG;
??? wSingleWordDMA : Word;
??? wMultiWordDMA : 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 ChangeByteOrder( var Data; Size : Integer );
? var
??? ptr : PChar;
??? i : Integer;
??? c : Char;
? begin
??? ptr := @Data;
??? for i := 0 to (Size shr 1)-1 do begin
????? 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 then Exit;
??? 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;
????? with pInData^ do begin
??????? cBufferSize := IDENTIFY_BUFFER_SIZE;
??????? bDriveNumber := 0;
??????? with irDriveRegs do begin
????????? bFeaturesReg := 0;
????????? bSectorCountReg := 1;
????????? bSectorNumberReg := 1;
????????? bCylLowReg := 0;
????????? bCylHighReg := 0;
????????? bDriveHeadReg := $A0;
????????? bCommandReg := IDE_ID_FUNCTION;
??????? end;
????? end;
????? if not DeviceIoControl( hDevice,IOCTL_SCSI_MINIPORT,????? @Buffer,@Buffer,????? cbBytesReturned,nil ) then Exit;
??? finally
????? CloseHandle(hDevice);
??? end;
? end else begin // Windows 95 OSR2,Windows 98
??? hDevice := CreateFile( ‘//./SMARTVSD‘,nil,CREATE_NEW,0 );
??? if hDevice=INVALID_HANDLE_VALUE then Exit;
??? try
????? pInData := PSendCmdInParams(@Buffer);
????? pOutData := @pInData^.bBuffer;
????? with pInData^ do begin
??????? cBufferSize := IDENTIFY_BUFFER_SIZE;
??????? bDriveNumber := 0;
??????? with irDriveRegs do begin
????????? bFeaturesReg := 0;
????????? bSectorCountReg := 1;
????????? bSectorNumberReg := 1;
????????? bCylLowReg := 0;
????????? bCylHighReg := 0;
????????? bDriveHeadReg := $A0;
????????? bCommandReg := IDE_ID_FUNCTION;
??????? end;
????? 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(PChar(pOutData)+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: String): Boolean;
begin
? Result := False;
? if s = ‘‘ then
??? Result := True;
end;

{procedure StringWrite (f: file; s: String);
begin
end;

procedure StringRead (f: file; s: String);
begin
end;
?}
function SLtrim (s: String): String;
begin
end;

function STrim (s: String): String;
begin
end;

function SAllTrim (s: String): String;
begin
end;

function SRemoveSpace (s: String): String;
var
? I???? : Integer;
? Count : Integer;
begin
? Result:= ‘‘;
? Count := length(s);
? for I := 1 to Count do begin
??? if s[I] <> ‘ ‘ then begin
????? Result? := Result + s[I];
??? end;
? end;
end;

procedure SSplitString (s: String; s1: String; s2: String);
begin
end;

procedure SSplitString1 (s: String; s1: String; s2: String);
begin
end;

function SIntToStrFix (n: Integer; cnt: Integer): String;
begin
end;

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 begin
??? Result := Result / 10;
? end;
end;

function AEqu (v1: Double; v2: Double): Boolean;
begin
? result := False;
? if v1 = v2 then
??? result := True
end;

function ASmall (v1: Double; v2: Double): Boolean;
begin
? result := False;
? if v1 < v2 then
??? result := True;
end;

function ABig (v1: Double; v2: Double): Boolean;
begin
? result := False;
? if v1 > v2 then
??? result := True;
end;

function AIsZero (v1: Double): Boolean;
begin
? Result := False;
? if V1 = 0 then Result := True;
end;

function AMax(a: Double; b: Double): Double;
begin
? if a >= 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;

function RealToStr1 (v: Double): String;
begin
end;

function StrToReal(s: String): Double;
var
? I : Integer;
? B : Boolean;
begin
? B := True;
? result := 0;
? for I := 1 to length(s) do begin
??? 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;

? if B and (Length(s) <> 0) then
??? result := StrToFloat(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 := result / Max;
end;

function RealStrN (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,Day);
? result := IntToStr(year) + ‘年‘ + IntToStr(Month) + ‘月‘ + IntToStr(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,‘年‘,‘-‘,[]);
? NewStr := StringReplace(NewStr,‘月‘,‘日‘,‘‘,[]);

? if IsDate(NewStr) then Result := StrToDate(NewStr)
? else Result := SysUtils.Date;
end;

function RealStr1 (v: Double; len: Integer; dec: Integer): String;
begin
? 
end;

function RealStr2 (v: Double; len: Integer; dec: Integer): String;
begin
end;

function RealStr3 (v: Double; len: Integer; dec: Integer): String;
begin
end;

function RealStr4 (v: Double; len: Integer; dec: Integer): String;
begin
end;

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 begin
??? if (ord(s[I]) > 57) or (ord(s[I]) < 48) then begin
????? B := False;
????? Break;
??? end;
? end;

? if B and (Length(s) <> 0) then
??? result := StrToInt(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 Val: string);
var
? Child_Node : IXMLNode;
begin
? Child_Node := XML.ChildNodes.First;
? if (Child_Node.NodeName = 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 begin
??? Stream.Read(S,1);
??? Filestr:= Filestr + s;
? end;
end;

procedure WriteToStream(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://将filestr 写入流中
procedure WriteToStream(Stream: TStream; const Filestr: string);
var
? Count : integer;
? I : integer;
? S : Char;
begin
? Count:= length(Filestr);
? WriteToStream(Stream,Count);

? for I:= 1 to Count do begin
??? 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;
begin
end;

procedure WriteToStream (stream: TStream; const v: Word); overload;
begin
end;

procedure WriteToStream (stream: TStream; const v: Double); overload;
begin
? Stream.Write(V,sizeof(V));
end;


procedure ReadFromStream (stream: TStream; var v: Cardinal); overload;
begin
end;

procedure ReadFromStream (stream: TStream; var v: Word); overload;
begin
end;

procedure ReadFromStream (stream: TStream; var v: Double); overload;
begin
? Stream.Read(V,sizeof(v));
end;

procedure WriteToStream (stream: TStream; const sList: TStringList); overload;
begin
end;

procedure ReadFromStream (stream: TStream; var sList: TStringList); overload;
begin
end;

procedure WriteToStream (stream: TStream; const iary: array of Integer); overload;
begin
end;

procedure ReadFromStream (stream: TStream; var iary: array of Integer); overload;
begin
end;

function StrLike (sou: String; key: String): Boolean;
begin
? result := False;
? if pos(sou,key) > 0 then
??? result := True;
end;

function SRight (s: String; n: Integer): String;
var
? I?? : Integer;
begin
? Result := ‘‘;
? for I := 1 to n do begin
??? Result := Result + s[I];
? end;
end;

procedure LoadFileList (Path: String; slist: TStrings; noPath: Boolean);
begin
end;

function TimeTicket: Longint;
begin
? Result := 0;
end;

function MonthOfDate (date: TDateTime): Integer;
begin
? Result := 0;
end;

function DayOfDate (date: TDateTime): Integer;
begin
? Result := 0;
end;

function YearOfDate (date: TDateTime): Integer;
begin
? Result := 0;
end;

function GetSplitWord (s: String; splitc: Char): String;
begin
end;

function HexToInt (s: String): Integer;
begin
? Result := 0;
end;

function TransStrByTable (sou: String; ori: TStringList; des: TStringList): String;
begin
end;

procedure LoadTransTable (fn: String; sou: TStringList; tag: TStringList);
begin
end;

function MakeFilePath (s: String): String;
begin
end;

function RemoveNote (s: String): String;
begin
end;

function MakePath (path: String): String;
begin
end;

function Blone (tj: String; v: String): Boolean;
begin
? Result := False;
end;

function CodeStr (s: String): String;
begin
end;

function DeCodeStr (s: String): String;
begin
end;

function GetValueFromStr (vname: String; s: String; txt: String): Boolean;
begin
? Result := False;
end;

function GetParaList (txt: String; ss: TStringList): Boolean;
begin
? Result := False;
end;

function SReplace (txt: String; sou: String; tag: String): String;
begin
end;


procedure TObjList.LoadFromStream(stream: TStream);
var
? I : integer;
? tmpCount : integer;
? tmp: TObject;? 
begin
? ReadFromStream(Stream,tmpCount);
? for I:= 0 to tmpCount - 1 do begin
??? Stream.Read(tmp,SizeOf(tmp));
??? Add(tmp); 
? end;
end;

procedure TObjList.SaveToStream(stream: TStream);
var
? I : integer;
? tmp: TObject;
begin
? WriteToStream(Stream,Count);
? for I:= 0 to Count - 1 do begin
??? tmp := Items[I];
??? Stream.Write(tmp,Sizeof(tmp));
? end;
end;

end.