{**********************************************
***  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,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                
                       
                    
                    
 
                      




鲜花




握手




雷人




路过




鸡蛋