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; // divId := 'LX000000';
implementation
file://得到下一编号
function GetNextStrId(const PreId: string): string; // divId := '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,wMonth,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, 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 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, BufferSize, @Buffer, BufferSize,
cbBytesReturned, nil ) then Exit;
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 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, Month, 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,'月','-',[]);
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.