communal.pas

自己整理的 适合新人看 集合有点乱 内容都不错的

function CPUSpeed: Double;
{* 获知当前机器CPU的速率（MHz）}

type
	TCPUID	= array[1..4] of Longint;
function GetCPUID : TCPUID; assembler; register;
{*获取CPU的标识ID号*}

function GetMemoryTotalPhys : Dword;
{*获取计算机的物理内存}

type
   TDriveState = (DSNODISK, DSUNFORMATTEDDISK, DSEMPTYDISK, DSDISK_WITHFILES);
function DriveState (driveletter: Char) : TDriveState;
{* 检查驱动器A中磁盘是否有效}

//▎============================================================▎//
//▎=====================⑧网络功能函数=========================▎//
//▎============================================================▎//
function GetComputerName:string;
{* 获取网络计算机名称}
function GetHostIP:string;
{* 获取计算机的IP地址}
function NetUserChangePassword(Domain:PWideChar; UserName:PWideChar; OldPassword:PWideChar; NewPassword:PWideChar): LongInt; stdcall; external 'netapi32.dll' name 'NetUserChangePassword';
{* // 运行平台：Windows NT/2000/XP
{* // Windows 95/98/Me平台：可以用该函数修改用户的Windows登录密码}


//▎============================================================▎//
//▎=====================⑨汉字拼音功能函数=====================▎//
//▎============================================================▎//
function GetHzPy(const AHzStr: string): string;       {测试通过}
{* 取汉字的拼音}

function HowManyChineseChar(Const s:String):Integer;
{* 判断一个字符串中有多少各汉字}

//▎============================================================▎//
//▎===================⑩数据库功能函数及过程===================▎//
//▎============================================================▎//
{function PackDbDbf(Var StatusMsg: String): Boolean;}
{* 物理删除数据库(Db，Dbf)中的数据[着了删除标记的记录]}


procedure RepairDb(DbName: string);
{* 修复Access表}

function CreateODBCCfgInRegistry(ODBCSourceName:WideString;ServerName, DataBaseDescription:String):boolean;
{* 通过注册表创建ODBC配置[创建在系统DSN页下]}

function ADOConnectSysBase(Const Adocon:TadoConnection):boolean;
{* 用Ado连接SysBase数据库函数}

function ADOConnectLocalDB(Const Adocon:TadoConnection;Const Dbname,DbServerName:string;ValidateMode:Integer):boolean;
{* 用Ado连接数据库函数}

function ADOODBCConnectLocalDB(Const Adocon:TadoConnection;Const Dbname:string;ValidateMode:Integer):boolean;
{* 用Ado与ODBC共同连接数据库函数}

function CreatTable(LpDataBaseName,LpTableName,LpSentence:string):Boolean;
{* //建立新表}

function AddField(LpFieldName:string; LpDataType: TFieldType; LpSize: Word):string;
{*//在表中添加字段}

function KillField(LpFieldName:string):String;
{* //在表中删除字段}

function AlterTableExec(LpDataBaseName,LpSentence:string):Boolean;
{* //修改表结构}

function GetSQLSentence(LpTableName,LpSQLsentence:string): string;
{* /修改、添加、删除表结构时的SQL句体}


//▎============================================================▎//
//▎======================⑾进制函数及过程======================▎//
//▎============================================================▎//

function StrToHex(AStr: string): string;
{* 字符转化成十六进制}

function HexToStr(AStr: string): string;
{* 十六进制转化成字符}

function TransChar(AChar: Char): Integer;

//▎============================================================▎//
//▎=====================⑿其它函数及过程=======================▎//
//▎============================================================▎//

function TrimInt(Value, Min, Max: Integer): Integer; overload;    {测试通过}
{* 输出限制在Min..Max之间}

function IntToByte(Value: Integer): Byte; overload;   {测试通过}
{* 输出限制在0..255之间}

function InBound(Value: Integer; Min, Max: Integer): Boolean;    {测试通过}
{* 判断整数Value是否在Min和Max之间}

procedure CnSwap(var A, B: Byte); overload;
{* 交换两个数}
procedure CnSwap(var A, B: Integer); overload;
{* 交换两个数}
procedure CnSwap(var A, B: Single); overload;
{* 交换两个数}
procedure CnSwap(var A, B: Double); overload;
{* 交换两个数}

function RectEqu(Rect1, Rect2: TRect): Boolean;
{* 比较两个Rect是否相等}

procedure DeRect(Rect: TRect; var x, y, Width, Height: Integer);
{* 分解一个TRect为左上角坐标x, y和宽度Width、高度Height}

function EnSize(cx, cy: Integer): TSize;
{* 返回一个TSize类型}

function RectWidth(Rect: TRect): Integer;
{* 计算TRect的宽度}

function RectHeight(Rect: TRect): Integer;
{* 计算TRect的高度}

procedure Delay(const uDelay: DWORD);     {测试通过}
{* 延时}

procedure BeepEx(const Freq: WORD = 1200; const Delay: WORD = 1);     {Win9X下测试通过}
{* 只能在Win9X下让喇叭发声}

procedure ShowLastError;       {测试通过}
{* 显示Win32 Api运行结果信息}

function writeFontStyle(FS: TFontStyles; inifile: string; write: boolean):string;
{* 将字体Font.Style写入INI文件}

function readFontStyle(inifile: string): TFontStyles;
{* 从INI文件中读取字体Font.Style文件}

//function ReadCursorPos(SourceMemo: TMemo): TPoint;
function ReadCursorPos(SourceMemo: TMemo): string;
{* 取得TMemo 控件当前光标的行和列信息到Tpoint中}

function CanUndo(AMemo: TMemo): Boolean;
{* 检查Tmemo控件能否Undo}

procedure Undo(Amemo: Tmemo);
{*实现Undo功能}

procedure AutoListDisplay(ACombox:TComboBox);
{* 实现ComBoBox自动下拉}

function UpperMoney(small:real):string;
{* 小写金额转换为大写 }

function Myrandom(Num: Integer): integer;
{*利用系统时间产生随机数)}

procedure OpenIME(ImeName: string);
{*打开输入法}

procedure CloseIME;
{*关闭输入法}

procedure ToChinese(hWindows: THandle; bChinese: boolean);
{*打开中文输入法}

//数据备份
procedure BackUpData(LpBackDispMessTitle:String);


implementation  {▎=======函数及过程体开始==========▎}

//▎============================================================▎//
//▎==================①扩展的字符串操作函数====================▎//
//▎============================================================▎//

// 判断s1是否包含在s2中
function InStr(const sShort: string; const sLong: string): Boolean;
var
  s1, s2: string;
begin
  s1 := LowerCase(sShort);
  s2 := LowerCase(sLong);
  Result := Pos(s1, s2) > 0;
end;

// 扩展整数转字符串函数，参数分别为目标数、长度、填充字符（默认为０）
function IntToStrEx(Value: Integer; Len: Integer; FillChar: Char = '0'): string;
begin
  Result := IntToStr(Value);
  while Length(Result) < Len do
    Result := FillChar + Result;
end;

// 带分隔符的整数－字符转换
function IntToStrSp(Value: Integer; SpLen: Integer = 3; Sp: Char = ','): string;
var
  s: string;
  i, j: Integer;
begin
  s := IntToStr(Value);
  Result := '';
  j := 0;
  for i := Length(s) downto 1 do
  begin
    Result := s[i] + Result;
    Inc(j);
    try
       if ((j mod SpLen) = 0) and (i <> 1) then
          Result := Sp + Result;
    except
       MessageBox(Application.Handle,' IntToStrSp函数的第二个参数值不能为数字0 ！',SCnError,16);
       exit;
    end
  end;
end;

// 返回字符串右边的字符
function StrRight(Str: string; Len: Integer): string;
begin
  if Len >= Length(Str) then
    Result := Str
  else
    Result := Copy(Str, Length(Str) - Len + 1, Len);
end;

// 返回字符串左边的字符
function StrLeft(Str: string; Len: Integer): string;
begin
  if Len >= Length(Str) then
    Result := Str
  else
    Result := Copy(Str, 1, Len);
end;

// 字节转二进制串
function ByteToBin(Value: Byte): string;
const
  V: Byte = 1;
var
  i: Integer;
begin
  for i := 7 downto 0 do
    if (V shl i) and Value <> 0 then
      Result := Result + '1'
    else
      Result := Result + '0';
end;

// 返回空格串
function Spc(Len: Integer): string;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to Len - 1 do
    Result := Result + ' ';
end;

// 返回将指定字符s1用字符串s2替换后的字符串，可支持大小写敏感由CaseSensitive操作}
function Replace(Str,s1,s2:string;CaseSensitive:Boolean):string;
var
   i:integer;
   s,t:string;
begin
   s:='';
   t:=str;
   repeat
      if casesensitive then
         i:=pos(s1,t)
      else
         i:=pos(lowercase(s1),lowercase(t));
         if i>0 then
            begin
               s:=s+Copy(t,1,i-1)+s2;
               t:=Copy(t,i+Length(s1),MaxInt);
            end
         else
            s:=s+t;
   until i<=0;
   result:=s;
end;

function Replicate(pcChar:Char; piCount:integer):string;
begin
	Result:='';
	SetLength(Result,piCount);
	fillChar(Pointer(Result)^,piCount,pcChar)
end;

// 返回某个字符串中某个字符串中出现的次数}
function StrNum(ShortStr:string;LongString:string):Integer;     {测试通过}
var
   i:Integer;
begin
   i:=0;
   while pos(ShortStr,LongString)>0 do
      begin
         i:=i+1;
         LongString:=Substr(LongString,(FindStr(ShortStr,LongString))+1,Length(LongString)-FindStr(ShortStr,LongString))
      end;
   Result:=i;
end;

// 返回某个字符串中查找某个字符串的位置}
function FindStr(ShortStr:String;LongStrIng:String):Integer;//在一个字符串中找某个字符的位置
var
   locality:integer;
begin
   locality:=Pos(ShortStr,LongStrIng);
   if locality=0 then
      Result:=0
   else
      Result:=locality;
end;

// 返回从位置BeginPlace开始切取长度为CatLeng字符串}
function SubStr(psInput:String; BeginPlace,CutLeng:Integer):String;
begin
	Result:=Copy(psInput,BeginPlace,CutLeng)
end;

// 返回从左边第一为开始切取 CutLeng长度的字符串
function LeftStr(psInput:String; CutLeng:Integer):String;
begin
	Result:=Copy(psInput,1,CutLeng)
end;

// 返回从左边第一为开始切取 CutLeng长度的字符串
function RightStr(psInput:String; CutLeng:Integer):String;
begin
	Result:=Copy(psInput,Length(psInput)-CutLeng+1,CutLeng)
end;

{* 返回从psInput字符串左边开始用pcPadWith填充后总长度为PiWidth的字符串}
function PadLStr(psInput:String; piWidth:Integer; pcPadWith:Char):String;
begin
	Result:=Replicate(pcPadWith,piWidth-Length(psInput))+psInput
end;

{* 返回从psInput字符串右边开始用pcPadWith填充后总长度为PiWidth的字符串}
function PadRStr(psInput:String; piWidth:Integer; pcPadWith:Char):String;
begin
	Result:=psInput+Replicate(pcPadWith,piWidth-Length(psInput))
end;

{* 返回从psInput字符串两边开始用pcPadWith填充后总长度为PiWidth的字符串}
function PadCStr(psInput:String; piWidth:Integer; pcPadWith:Char):String;
var
	liHalf :integer;
begin
	liHalf:=(piWidth-Length(psInput))div 2;
	Result:=Replicate(pcPadWith,liHalf)+psInput+Replicate(pcPadWith,piWidth-Length(psInput)-liHalf)
end;

{* 返回替换后字符串 Examples: ChrTran('abCdEgdlkh','d','#')； 返回'bC#Eg#lkh'}
function ChrTran(psInput:String; pcSearch:Char; pcTranWith:Char):String;
var
	i,j:integer;
begin
	j:=Length(psInput);
	for i:=1 to j do
  begin
		if psInput[i]=pcSearch then
			psInput[i]:=pcTranWith
  end;
	Result:=psInput
end;

{* 返回替换后字符串 Examples: StrTran('aruyfbn','ruy','====='); 返回'a=====fbn'}
function StrTran(psInput:String; psSearch:String; psTranWith:String):String;
var
	liPosition,liLenOfSrch,liLenOfIn:integer;
begin
	liPosition:=Pos(psSearch,psInput);
	liLenOfSrch:=Length(psSearch);
	liLenOfIn:=Length(psInput);
	while liPosition>0 do
	begin
		psInput:=Copy(psInput,1,liPosition-1)
			+psTranWith
      +Copy(psInput,liPosition+liLenOfSrch,liLenOfIn);
		liPosition:=Pos(psSearch,psInput)
	end;
	Result:=psInput
end;

{ *返回替换后字符串[替换字符串] Examples: Stuff('ABCDEFGHI',3,4,'12345')；返回'AB12345GHI'}
function Stuff(psInput:String; piBeginPlace,piCount:Integer; psStuffWith:String):String;
begin
	Result:=Copy(psInput,1,piBeginPlace-1)+
		psStuffWith+
    Copy(psInput,piBeginPlace+piCount,Length(psInput))
end;

// 交换字串
procedure SwapStr(var s1, s2: string);
var
  tempstr: string;
begin
  tempstr := s1;
  s1 := s2;
  s2 := tempstr;
end;

const
  csLinesCR = #13#10;
  csStrCR = '\n';

// 多行文本转单行（换行符转'\n'）
function LinesToStr(const Lines: string): string;
var
  i: Integer;
begin
  Result := Lines;
  i := Pos(csLinesCR, Result);
  while i > 0 do
  begin
    system.Delete(Result, i, Length(csLinesCR));
    system.insert(csStrCR, Result, i);
    i := Pos(csLinesCR, Result);
  end;
end;

// 单行文本转多行（'\n'转换行符）
function StrToLines(const Str: string): string;
var
  i: Integer;