utchpublicfun.pas

delphi底层函数delphi底层函数delphi底层函数delphi底层函数

    T := Semi(S, M);
    Inc(Result);
  end;
end;
////////////////////////////////////////////////////////////////////// todo:
//语法：SemiX(var S: String; Sm: String): String;
//说明：
//参数：S    子串
//参数：Sm   字符串
function SemiX(var S: String; Sm: String): String;
var
  I: Integer;
begin
  Result := '';
  if S = '' then
    Exit;
  if Pos(S[1], Sm) > 0 then
    for I := 2 to Length(S) do
      if Pos(S[I], Sm) > 0 then
      begin
        Result := Copy(S, 1, I - 1);
        S := Copy(S, I, 65535);
        Exit;
      end;
  Result := S;
  S := '';
end;
//////////////////////////////////////////////////////////////////todo:
//语法：IncStr(St: String): String;
//说明：
//参数：St   字符串
function IncStr(St: String): String;
var
  I: LongInt;
  N: Integer;
begin
  Result := '';
  N := 1;
  for I := Length(St) downto 1 do
  begin
    if St[I] in ['0'..'9'] then
    else
    begin
      //if i<>length(st) then
      Result := Copy(St, 1, I) + Format('%0.0*d', [N, StoI(Copy(St, I + 1,
        65535)) + 1]);
      //else break;
      Exit;
    end;
    Inc(N);
  end;
  Result := St;
end;
///////////////////////////////////////////////////////////////////
//语法：TrimAll(St: String): String;
//说明：去左右空格
//参数：St
function TrimAll(St: String): String;
var
  N: Integer;
  Mm, Nn: Integer;
begin
  Result := '';
  if St = '' then
    Exit;
  Mm := 1;
  Nn := Length(St);
  for N := 1 to Length(St) do
    if (St[N] = ' ') or (St[N] = #0) then
      Inc(Mm)
    else
      break;
  for N := Length(St) downto 1 do
    if (St[N] = ' ') or (St[N] = #0) then
      Dec(Nn)
    else
      break;
  Result := Copy(St, Mm, Nn - Mm + 1);
end;

//////////////////////////////////////////////////////////////////
//语法：TchReplace(Str : String): String;
//说明：将字符串中的单引号替换为两个单引号。
//参数：Str   字符串
function TchReplace(Str: String): String;
var
  ReplaceI, ReplaceJ: Integer;
  WillCutStr: String;
begin
  WillCutStr := '';
  Result := '';
  while Pos('''', Str) > 0 do
  begin
    ReplaceI := Pos('''', Str);
    for ReplaceJ := 1 to ReplaceI do
      Result := Result + Copy(Str, ReplaceJ, 1);
    Result := Result + '''';
    Str := Copy(Str, ReplaceI + 1, Length(Str) - ReplaceI);
  end;
  Result := Result + Str;
end;

/////////////////////////////////////////////////////////////////////
//语法：SToI(S: String): LongInt;
//说明：把字符串转化成整型，在S中遇到非法字符时，取非法字符前面的数字
//参数：S
function SToI(S: String): LongInt;
var
   N:LongInt;
   Code:Integer;
begin
  try
    Val(S, N, Code);
  except
    N := 0;
  end;
  StoI := N;
end;
//////////////////////////////////////////////////////////////////////
//语法：IToS(No: LongInt): String;
//说明：把整型转化成字符串
//参数：No
function IToS(No: LongInt): String;
var
  S: String[20];
begin
  Str(No, S);
  IToS := S;
end;
///////////////////////////////////////////////////////////////////
//语法：FontToStr(V: TFont): String;
//说明：把字体按一定的格式转化为字符串。格式为：字体名称、字体大小、字体颜色、字体风格。
//参数：V     字体
function FontToStr(V: TFont): String;
var
  S: String;
begin
  S := V.Name + ';' + IntToStr(V.size) + ';$' + IntToHex(Ord(V.color), 6) + ';';
  if fsBold in V.Style then
    S := S + 'B';
  if fsItalic in V.Style then
    S := S + 'I';
  if fsUnderline in V.Style then
    S := S + 'U';
  if fsStrikeOut in V.Style then
    S := S + 'S';
  FontToStr := S;
end;
//////////////////////////////////////////////////////////////////////////////////
//语法：StrToFont(S: String; V: TFont);
//说明：把指定的字符串转化为字体。
//参数：S    字符串
//参数：V    字体
procedure StrToFont(S: String;V: TFont);
var
  T: String;
  Sm: Char;
begin
  V.Style := [];
  Sm := ';';
  if Pos(',', S) > 0 then
    Sm := ',';
  try
    if S <> '' then
    begin
      T := Semi(S, Sm);
      V.Name := T;
      T := Semi(S, Sm);
      V.Size := StrToInt(T);
      T := Semi(S, Sm);
      V.Color := TColor(StrToint(T));
      if Pos('B', S) > 0 then
        V.Style := V.Style + [fsBold];      //粗体
      if Pos('I', S) > 0 then
        V.Style := V.Style + [fsItalic];    //斜体
      if Pos('U', S) > 0 then
        V.Style := V.Style + [fsUnderLine]; //下划线
      if Pos('S', S) > 0 then
        V.Style := V.Style + [fsStrikeOut]; //中划线
    end;
  except
  end;
end;
///////////////////////////////////////////////////////////////////
//语法：XToD(Const Num: Real): String;
//说明：将小写金额转化成大写金额。
//参数：Num       小写金额
function XToD(Const Num: Real): String;
var
  Aa, Bb, Cc: String;
  Bbb: Array[1..16] of String;
  Uppna: Array[0..9] of String;
  I: Integer;
begin
  Bbb[1] := '万';
  Bbb[2] := '仟';
  Bbb[3] := '佰';
  Bbb[4] := '拾';
  Bbb[5] := '亿';
  ;
  Bbb[6] := '仟';
  ;
  Bbb[7] := '佰';
  Bbb[8] := '拾';
  Bbb[9] := '万';
  Bbb[10] := '仟';
  Bbb[11] := '佰';
  Bbb[12] := '拾';
  Bbb[13] := '元';
  Bbb[14] := '.';
  Bbb[15] := '角';
  Bbb[16] := '分';
  Uppna[1] := '壹';
  Uppna[2] := '贰';
  Uppna[3] := '叁';
  Uppna[4] := '肆';
  Uppna[5] := '伍';
  Uppna[6] := '陆';
  Uppna[7] := '柒';
  Uppna[8] := '捌';
  Uppna[9] := '玖';
  Str(Num: 16: 2, Aa);
  Cc := '';
  Bb := '';
  Result := '';
  for I := 1 to 16 do
  begin
    Cc := Aa[I];
    if Cc <> ' ' then
    begin
      Bb := Bbb[I];
      if Cc = '0' then
        Cc := '零'
      else
      begin
        if Cc = '.' then
        begin
          Cc := '';
          Bb := '';
        end
        else
        begin
          Cc := Uppna[StrToInt(Cc)];
        end
      end;
      Result := Result + (Cc + Bb)
    end;
  end;
  //Result:=Result+'正';
end;

//////////////////////////////////////////////////////////////////////
//语法：EncryptFile(InfName, OutfName: String; Key: Word);
//说明：对文件进行加密。
//参数：InfName      源文件名
//参数：OutfName     目标文件名
//参数：Key
//常量：C1  =  52845;
//常量：C2  =  22719;
procedure EncryptFile(InfName, OutFName: String; Key: Word);
var
  MS, SS: TMemoryStream;
  X: Integer;
  C: Byte;
begin
  MS := TMemoryStream.Create;
  SS := TMemoryStream.Create;
  try
    MS.LoadFromFile(InfName);
    MS.Position := 0;
    for X := 0 to MS.Size - 1 do
    begin
      MS.Read(C, 1);
      C := (C Xor (Key Shr 8));
      Key := (C + Key) * C1 + C2;
      SS.Write(C, 1);
    end;
    SS.SaveToFile(OutfName);
  finally
    SS.Free;
    MS.Free;
  end;
end;
/////////////////////////////////////////////////////////////
//语法：DecryptFile(InfName, OutfName: String; Key: Word);
//说明：对文件进行解密，相对于EncryptFile函数。
//参数：InfName     源文件名(已加密)
//参数：OutfName    目标文件名
//参数：Key
procedure DecryptFile(InfName, OutfName: String; Key: Word);
var
  MS, SS: TMemoryStream;
  X: Integer;
  C, O: Byte;
begin
  MS := TMemoryStream.Create;
  SS := TMemoryStream.Create;
  try
    MS.LoadFromFile(InfName);
    MS.Position := 0;
    for X := 0 to MS.Size - 1 do
    begin
      MS.Read(C, 1);
      O := C;
      C := (C Xor (Key Shr 8));
      Key := (O + Key) * C1 + C2;
      SS.Write(C, 1);
    end;
    SS.SaveToFile(OutfName);
  finally
    SS.Free;
    MS.Free;
  end;
end;
//////////////////////////////////////////////////////////////////////////
//语法：ExecuteFile(Const FileName, Params, DefaultDir: String;
//  ShowCmd: Integer): THandle;
//说明：运行与文件关联的程序。
//参数：FileName      执行文件名
//参数：Params        参数
//参数：DefaultDir    程序缺省路径
//参数：ShowCmd       执行命令
function ExecuteFile(Const FileName, Params, DefaultDir: String;
  ShowCmd: Integer): THandle;
var
  zFileName, zParams, zDir: Array[0..79] of Char;
begin
  Result := ShellExecute(Application.Handle, Nil,
    StrPCopy(zFileName, FileName), StrPCopy(zParams, Params),
    StrPCopy(zDir, DefaultDir), ShowCmd);
end;
////////////////////////////////////////////////////////////////////////
//语法：CutPath(FName: String): String;
//说明：截取文件名根目录。
//参数：FName      文件名。
function CutPath(FName: String): String;
var
  I: Word;
begin
  for I := Length(FName) downto 1 do
  begin
    if FName[I] = '\' then
    begin
      Result := Copy(FName, 1, I - 1);
      Exit;
    end;
  end;
  Result := FName;
end;
////////////////////////////////////////////////////////////////////////////
//语法：CutName(FName: String): String;
//说明：截取文件名。
//参数：FName    文件名。
function CutName(FName: String): String;
var
  I: Word;
begin
  for I := Length(FName) downto 1 do
  begin
    if (FName[I] = '\') or (FName = ':') then
    begin
      Result := Copy(FName, I + 1, 65535);
      Exit;
    end;
  end;
  Result := FName;
end;
/////////////////////////////////////////////////////////////////////////////////// todo:
//语法：CombineFile(var Path: String; S: String; Size: LongInt): String;
//说明：
//参数：Path
//参数：S
//参数：Size
//该函数中调用了IncStr、SToI、CutName、CutPath四个函数。
function CombineFile(var Path: String; S: String; Size: LongInt): String;
var
  F, G: HFile;
  Ss: String;
  Buf: Array[0..2048] of char;
  Nn, Sizes: LongInt;
  Rr, M: Integer;
  Ok: Boolean;
  procedure NewPath(var S: String);
  var
    St: String;
  begin
    Ok := True;
    while not FileExists(S) do
    begin
      St := CutPath(S);
      Screen.Cursor := crDefault;
      St := IncStr(St);
      if FileExists(St + '\' + CutName(S)) then
      begin
        S := St + '\' + CutName(S);
        break;
      end;
      Ok := InputQuery('插入新盘或指出文件的所在路径', '路径：' + S, St);
      Screen.Cursor := crHourGlass;
      if not Ok then
        break;
      if St[Length(St)] = '\' then
        St := Copy(St, 1, Length(St) - 1);
      S := St + '\' + CutName(S);
    end;
    Path := CutPath(S);
  end;
begin
  NewPath(S);
  Result := S;
  F := _lOpen(Pchar(S), OF_READ);
  Nn := _lLseek(F, 0, File_END);
  _lClose(F);
  if Nn = Size then
    Exit;
  Sizes := 0;
  Ss := 'C:\SCSTEMP';
  G := _lCreat(PChar(Ss), 0);
  if G = HFile_ERROR then
  begin
    ShowMessage('创建文件' + Ss + '错误!');
    Exit;
  end;
  repeat
    F := _lOpen(Pchar(S), OF_READ);
    if G = HFile_ERROR then
      ShowMessage('打开文件' + S + '出错!');
    repeat
      Rr := _hRead(F, @buf, 2048);
      _hWrite(G, Buf, Rr);
      Sizes := Sizes + Rr;
    until Rr = 0;
    _lClose(F);
    if Sizes >= Size then
      break;
    M := Length(S);
    if S[M] in ['1'..'8'] then
      S[M] := Chr(Ord(S[M]) + 1)