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[..] of Longint;

 TVendor = array [..] 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 := ;

  for I := n downto  do begin

    c := PreId[I];

    if  (Ord(c) >= ) and (Ord(c) <= ) then begin

       n1 := I;

       Break;

    end;

  end;

  s := Copy(PreId, , n1);

  s1 := Copy(PreId, n1 + , );

  s1 := IntToStr(StrInt(s1) + );

  result := s1;

  for I :=  to  n - n1 - Length(s1) do

    Result := '' + Result;

  result := s + Result;

end;

file://不能输入字符

function CheckNullValue(var Key: Char): Boolean;

const

  ControlKeySet = [Char(#)];

begin

  Key := #;

  Result := True;

end;

{判断输入的字符是否是数字}

function CheckInputNum(const IsInteger: Boolean; AStr: string; var Key: Char): Boolean;

const

  NumberSet = ['' .. '', '.', '-'];

  ControlKeySet = [Char(#), Char(#)];

begin

  if Key in ControlKeySet then begin

    Result := True;

    Exit;

  end;

  if not (Key in NumberSet) then Key := #;

  if (Key = '.') and ((Length(AStr) = ) or (Pos('.', AStr) > )) then

    Key := #;

  file://不能前两个同时为0

  if (Length(AStr) = ) and (AStr[] = '') and (Key = '') then Key := #;

  file://不能有多个负号

  if (Pos('-', AStr) >= ) and (Key = '-') then Key := #;

  if IsInteger then begin

    if key = '.' then Key := #;

//    if (Length(AStr) = 1) and (AStr[1] = '0') or (Key = '.') then Key := #0;

  end;

  Result := Key <> #;

end;

{日期型字段显示过程,在OnGetText事件中调用}

procedure DateFieldGetText(Sender: TField; var Text: String);

var

  dDate: TDate;

  wYear,wMonth,wDay: Word;

  aryTestYMD: Array [..] of Char ;{测试输入掩码用临时数组}

  iYMD: Integer;

begin

  iYMD := ;

  dDate:= Sender.AsDateTime;

  DecodeDate(dDate,wYear,wMonth,wDay);

  {测试输入掩码所包含的格式.}

  aryTestYMD:= '年';

  if StrScan(PChar(Sender.EditMask), aryTestYMD[]) <> nil then iYMD:= ;

  aryTestYMD:= '月';

  if StrScan(PChar(Sender.EditMask), aryTestYMD[]) <> nil then iYMD:= ;

  aryTestYMD:= '日';

  if StrScan(PChar(Sender.EditMask), aryTestYMD[]) <> nil then iYMD:= ;

  case iYMD of

    :{输入掩码为:”yyyy年”的格式.}

    Text:= IntToStr(wYear) + '年';

    : {输入掩码为:”yyyy年mm月”的格式.}

    Text:= IntToStr(wYear) + '年' + IntToStr(wMonth) + '月';

    : {输入掩码为:”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 [..] of Char;

  iYMD: Integer;

begin

  iYMD := ;

{获得用户输入的日期}

  sYear := Copy(Text, , );

  sMonth:= Copy(Text, , );

  SDay  := Copy(Text, , );

{测试输入掩码所包含的格式.}

  aryTestYMD := '年';

  if StrScan( PChar(Sender.EditMask), aryTestYMD[] ) <> nil then iYMD := ;

  aryTestYMD := '月';

  if StrScan( PChar(Sender.EditMask), aryTestYMD[] ) <> nil then iYMD := ;

  aryTestYMD := '日';

  if StrScan( PChar(Sender.EditMask), aryTestYMD[] ) <> nil then iYMD := ;

  {利用Try…Except进行输入的日期转换}

  try begin

    case iYMD of

      : {输入掩码为:”yyyy年”的格式.}

        begin

        dDate := StrToDate( sYear + '-01-01' );{中文Windows默认的日期格式为:yyyy-mm-dd.下同}

        Sender.AsDateTime := dDate;

        end;

      : {输入掩码为:”yyyy年mm月”的格式.}

        begin

        dDate := StrToDate( sYear + '-' + sMonth + '-01' );

        Sender.AsDateTime:=dDate;

        end;

      : {输入掩码为:”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 [..] of char;

  tmpstr: string;

begin

  tmpstr := '';

  hWnd := WindowFromPoint(Sender);

  tmpstr := 'Handle : ' + IntToStr(hWnd);

  if boolean(GetClassName(hWnd, aName, )) 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 := ;

  Randomize;

  If Num =  then Exit;

  GetSystemTime(T);

  X := Trunc(T.wMilliseconds/) * T.wSecond * ;

  X := X + random();

  if X <  then X := -X;

  X := Random(X);

  X := X mod num;

  for I :=  to X do

    X := Random(Num);

  Result := X;

end;

function GetCurrentUserName : string;

const

  cnMaxUserNameLen = ;

var

  sUserName : string;

  dwUserNameLen : Dword;

begin

  dwUserNameLen := cnMaxUserNameLen-;

  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,

  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,

  DW      $A20F    {CPUID Command}

  MOV     EAX,EBX

  XCHG  EBX,ECX     {save ECX result}

  MOV   ECX,

@:

  STOSB

  SHR     EAX,

  LOOP    @

  MOV     EAX,EDX

  MOV   ECX,

@:

  STOSB

  SHR     EAX,

  LOOP    @

  MOV     EAX,EBX

  MOV   ECX,

@:

  STOSB

  SHR     EAX,

  LOOP    @

  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] := -;

    CPUID := GetCPUID;

  Result := Result + IntToHex(CPUID[],);

  Result := Result + IntToHex(CPUID[],);

  Result := Result + IntToHex(CPUID[],);

  Result := Result + IntToHex(CPUID[],);

  S := GetCPUVendor;

  Result := Result + S;

end;

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

  type

    TSrbIoControl = packed record

    HeaderLength : ULONG;

    Signature : Array[..] 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[..] of Byte;

    dwReserved : Array[..] of DWORD;

    bBuffer : Array[..] 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[..] of Word;

    sSerialNumber : Array[..] of Char;

    wBufferType : Word;

    wBufferSize : Word;

    wECCSize : Word;

    sFirmwareRev : Array[..] of Char;

    sModelNumber : Array[..] 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[..] of Byte;

  end;

  PIdSector = ^TIdSector;

const

  IDE_ID_FUNCTION = $EC;

  IDENTIFY_BUFFER_SIZE = ;

  DFP_RECEIVE_DRIVE_DATA = $0007c088;

  IOCTL_SCSI_MINIPORT = $0004d008;

  IOCTL_SCSI_MINIPORT_IDENTIFY = $001b0501;

  DataSize = sizeof(TSendCmdInParams)-+IDENTIFY_BUFFER_SIZE;

  BufferSize = SizeOf(SRB_IO_CONTROL)+DataSize;

  W9xBufferSize = IDENTIFY_BUFFER_SIZE+;

var

  hDevice : THandle;

  cbBytesReturned : DWORD;

  pInData : PSendCmdInParams;

  pOutData : Pointer; // PSendCmdOutParams

  Buffer : Array[..BufferSize-] of Byte;

  srbControl : TSrbIoControl absolute Buffer;

  procedure ChangeByteOrder( var Data; Size : Integer );

  var

    ptr : PChar;

    i : Integer;

    c : Char;

  begin

    ptr := @Data;

    for i :=  to (Size shr )- do begin

      c := ptr^;

      ptr^ := (ptr+)^;

      (ptr+)^ := c;

      Inc(ptr,);

     end;

  end;

begin

  Result := '';

  FillChar(Buffer,BufferSize,#);

  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, ,  );

    if hDevice=INVALID_HANDLE_VALUE then Exit;

    try

      srbControl.HeaderLength := SizeOf(SRB_IO_CONTROL);

      System.Move('SCSIDISK',srbControl.Signature,);

      srbControl.Timeout := ;

      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 := ;

        with irDriveRegs do begin

          bFeaturesReg := ;

          bSectorCountReg := ;

          bSectorNumberReg := ;

          bCylLowReg := ;

          bCylHighReg := ;

          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', , , nil, CREATE_NEW, ,  );

    if hDevice=INVALID_HANDLE_VALUE then Exit;

    try

      pInData := PSendCmdInParams(@Buffer);

      pOutData := @pInData^.bBuffer;

      with pInData^ do begin

        cBufferSize := IDENTIFY_BUFFER_SIZE;

        bDriveNumber := ;

        with irDriveRegs do begin

          bFeaturesReg := ;

          bSectorCountReg := ;

          bSectorNumberReg := ;

          bCylLowReg := ;

          bCylHighReg := ;

          bDriveHeadReg := $A0;

          bCommandReg := IDE_ID_FUNCTION;

        end;

      end;

      if not DeviceIoControl( hDevice, DFP_RECEIVE_DRIVE_DATA,

            pInData, SizeOf(TSendCmdInParams)-, pOutData,

            W9xBufferSize, cbBytesReturned, nil ) then Exit;

    finally

      CloseHandle(hDevice);

    end;

  end;

  with PIdSector(PChar(pOutData)+)^ 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 :=  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 :=  to N -  do begin

    Result := Result * ;

  end;

  Result := Round(Result);

  for I :=  to N -  do begin

    Result := Result / ;

  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 =  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 := ;

  for I :=  to length(s) do begin

    if (ord(s[I]) > ) or (ord(s[I]) < ) then begin

      if ord(s[I]) <>  then begin

        B := False;

        Break;

      end;

    end;

  end;

  if B and (Length(s) <> ) 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 := ;

  for I :=  to N do begin

    Max := Max * ;

  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 := ;

  if s = '' then begin

    result := ;

    Exit;

  end;

  for I :=  to length(s) do begin

    if (ord(s[I]) > ) or (ord(s[I]) < ) then begin

      B := False;

      Break;

    end;

  end;

  if B and (Length(s) <> ) 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 := ;

  ReadFromStream(Stream, Count);

  for I :=  to Count do begin

    Stream.Read(S, );

    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:=  to Count do begin

    S := FileStr[I];

    Stream.Write(S, );

  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) >  then

    result := True;

end;

function SRight (s: String; n: Integer): String;

var

  I   : Integer;

begin

  Result := '';

  for I :=  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 := ;

end;

function MonthOfDate (date: TDateTime): Integer;

begin

  Result := ;

end;

function DayOfDate (date: TDateTime): Integer;

begin

  Result := ;

end;

function YearOfDate (date: TDateTime): Integer;

begin

  Result := ;

end;

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

begin

end;

function HexToInt (s: String): Integer;

begin

  Result := ;

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:=  to tmpCount -  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:=  to Count -  do begin

    tmp := Items[I];

    Stream.Write(tmp, Sizeof(tmp));

  end;

end;

end.

delphi的一个公用函数库的更多相关文章

  1. Delphi另一个多线程函数：BeginThread用法

    Delphi另一个多线程函数:BeginThread━━━━━━━━━━━━━━━━━━━━━━━━━━ Delphi也提供了一个相同功能的类似函数:function BeginThread(    ...

  2. 一个ASP函数库

    <% '****************************** '类名: '名称:通用库 '日期:2008/10/28 '作者:by xilou '网址: '描述:通用库 '版权:转载请注 ...

  3. linux 函数库使用

    程序函数库可分为3种类型:静态函 数库(static libraries).共享函数库(shared libraries)和动态加载函数库(dynamically loaded libraries) ...

  4. [UE4]蓝图函数库小结

    蓝图函数库的功能非常强劲,如果在项目中使用的话有时能达到事半功倍的效果. 蓝图函数库,Blueprint Function Library.可以非常方便的将代码中的函数暴露给所有的蓝图使用,同时也提供 ...

  5. MySQL函数库

    MySQL函数库,这个函数库是一个外部函数库!这个函数提供了对于MySQL数据库进行操作的常用函数,如连接MySQL服务器.打开数据库.执行SQL语句等.所以这个函数库的功能对于我们来说是非常重要的! ...

  6. Underscore——JS函数库

    转载请注明原文地址:https://www.cnblogs.com/ygj0930/p/10826065.html underscore是什么——它是一个js函数库 jQuery统一了不同浏览器之间的 ...

  7. delphi公用函数

    {*******************************************************} { } { Delphi公用函数单元 } { } { 版权所有 (C) 2008 } ...

  8. 如何持续集成/交付一个开源.NET函数库到Nuget.org

    (此文章同时发表在本人微信公众号"dotNET每日精华文章",欢迎右边二维码来关注.) 题记:这是一个简单的入门向导,涉及到GitHub.AppVeyor和Nuget.org. 最 ...

  9. 自己的一个LESS工具函数库

    自己大概在一年前开始使用LESS编写样式,现在感觉不用LESS都不会写样式了.现在写静态页面完全离不开LESS与Zen Coding,我可以不用什么IDE,但这两个工具却必须要,当然也强烈推荐看到这篇 ...

随机推荐

  1. Objective-C GCD深入理解

    GCD(Grand Central Dispatch),主要用于多线程编程.它屏蔽了繁琐的线程实现及管理细节,将其交由系统处理.开发者只需要定义任务block(在底层被封装成dispatch_cont ...

  2. 【Codeforces 650 D】Zip-line

    题意:给一个序列以及\(n\)个查询,每一个查询是问(假装)把第\(a_i\)个数改为\(b_i\)之后原序列的最长上升子序列的长度. 思路:线段树优化\(dp\). 肯定离线做啊. 首先我们考虑\( ...

  3. 【Codeforces Round 1110】Codeforces Global Round 1

    Codeforces Round 1110 这场比赛只做了\(A\).\(B\).\(C\),排名\(905\),不好. 主要的问题在\(D\)题上,有\(505\)人做出,但我没做出来. 考虑的时候 ...

  4. Ubuntu 上安装QTAV第三方视频库

    安装QtAV的基本环境: sudo apt-get install build-essential sudo apt-get install libgl1-mesa-dev sudo apt-get ...

  5. Got fatal error 1236 from master when reading data from binary log: 'Client requested master to start replication from impossible position

    在source那边,执行: flush logs;show master status; 记下File, Position. 在target端,执行: CHANGE MASTER TO MASTER_ ...

  6. 谈高清显示接口HDMI、RGB、LVDS、MIPI、eDP、mini-LVDS、V-By-One

    近年来随着电子产业的高速发展,智能显示设备也取得了辉煌的成就,高清显示得到了消费者的青睐.目前高清显示协议接口有RGB.LVDS.MIPI.eDP.HDMI.miniLVDS.V-by-One等,由于 ...

  7. Java获取指定包名下的所有类的全类名的解决方案

        最近有个需求需要获取一个指定包下的所有类的全类名,因此特意写了个获取指定包下所有类的全类名的工具类.在此记录一下,方便后续查阅 一.思路         通过ClassLoader来查找指定包 ...

  8. 在WPF中使用Caliburn.Micro搭建MEF插件化开发框架

    原文:在WPF中使用Caliburn.Micro搭建MEF插件化开发框架 版权声明:原创内容转载必须注明出处,否则追究相关责任. https://blog.csdn.net/qq_36663276/a ...

  9. VM下设置CenOS为静态IP

    在本机利用VM启动了4台虚拟机来搭建zookeeper集群,但是每次电脑重启后,虚拟机的IP都会变化,现在想来固定每台虚拟机的IP. 1.Step1:查看网关和子网掩码 记住选用NAT模式,点击NAT ...

  10. 手机端@media的屏幕适配

    @media only screen and (width: 320px) { html { font-size: 16px; }} @media only screen and (width: 36 ...