publicfunc.~pas

delphi 编制的服务器程序

unit PublicFunc;

interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,db, AdoDb;

function MessageBoxQuery(AMsg: string):Integer ;
procedure MessageBoxWarning(AMsg: string);
procedure MessageBoxInfo(AMsg: string);
procedure OpenQuery(Q:TAdoQuery; s: string);
procedure ExecuteQuery(Q: TAdoQuery; SQL: string);
function GetPYIndexChar( hzchar:string):char;
function SearchByPYIndexStr(SourceStrs:TStrings;PYIndexStr:string):string;
function IntToStrEx(I: Integer;Len: Integer): string;
function FillCharEx(ch:Char; Len: Integer): string;
function Decrypt(Src:String; Key:String):string;
function EnCrypt(Src:String; Key:String):string;

implementation

//解密函数
function Decrypt(Src:String; Key:String):string;
var
  KeyLen :Integer;
  KeyPos :Integer;
  offset :Integer;
  dest :string;
  SrcPos :Integer;
  SrcAsc :Integer;
  TmpSrcAsc :Integer;
begin
  KeyLen:=Length(Key);
  if KeyLen = 0 then key:='Think Space';
  KeyPos:=0;
  offset:=StrToInt('$'+ copy(src,1,2));
  SrcPos:=3;
  repeat
    SrcAsc:=StrToInt('$'+ copy(src,SrcPos,2));
    if KeyPos < KeyLen Then KeyPos := KeyPos + 1 else KeyPos := 1;
    TmpSrcAsc := SrcAsc xor Ord(Key[KeyPos]);
    if TmpSrcAsc <= offset then
      TmpSrcAsc := 255 + TmpSrcAsc - offset
    else
      TmpSrcAsc := TmpSrcAsc - offset;
    dest := dest + chr(TmpSrcAsc);
    offset:=srcAsc;
    SrcPos:=SrcPos + 2;
  until SrcPos >= Length(Src);
  Result:=Dest;
end;



function EnCrypt(Src:String; Key:String):string;
var
  KeyLen :Integer;
  KeyPos :Integer;
  offset :Integer;
  dest :string;
  SrcPos :Integer;
  SrcAsc :Integer;
  Range :Integer;
begin
  KeyLen:=Length(Key);
  if KeyLen = 0 then key:='Think Space';
  KeyPos:=0;
  Range:=256;
  Randomize;
  offset:=Random(Range);
  dest:=format('%1.2x',[offset]);
  for SrcPos := 1 to Length(Src) do
  begin
    SrcAsc:=(Ord(Src[SrcPos]) + offset) MOD 255;
    if KeyPos < KeyLen then KeyPos:= KeyPos + 1 else KeyPos:=1;
    SrcAsc:= SrcAsc xor Ord(Key[KeyPos]);
    dest:=dest + format('%1.2x',[SrcAsc]);
    offset:=SrcAsc;
  end;
  Result:=Dest;
end;


function IntToStrEx(I: Integer;Len: Integer): string;
begin
  Result := IntToStr(I);
  if Length(Result)< Len then
  begin
    Result := FillCharEx('0',Len-Length(Result))+Result;
  end;
end;


function FillCharEx(ch:Char; Len: Integer): string;
begin
  SetLength(Result,Len);
  FillChar(Result[1],Len,Ord(Ch));
end;

function MessageBoxQuery(AMsg: string):Integer ;
begin
  Result := MessageBox(Application.Handle, PChar(AMsg),
            '询问',MB_ICONQUESTION+MB_YESNO+MB_DEFBUTTON2);

end;

procedure MessageBoxWarning(AMsg: string);
begin
  MessageBox(Application.Handle, PChar(AMsg),'警告',MB_ICONWARNING);
end;

procedure MessageBoxInfo(AMsg: string);
begin
  MessageBox(Application.Handle, PChar(AMsg),'提示',MB_ICONINFORMATION);
end;

procedure OpenQuery(Q:TAdoQuery; s: string);
begin
  with Q do
  begin
    Close;
    Sql.Text := s;
    Open;
  end;
end;

procedure ExecuteQuery(Q: TAdoQuery; SQL: string);
begin
  Q.Close;
  Q.SQL.Clear;
  Q.SQL.Add(SQL);
  Q.ExecSQL;
end;

function GetPYIndexChar( hzchar:string):char;
begin
  case WORD(hzchar[1]) shl 8 + WORD(hzchar[2]) of
    $B0A1..$B0C4 : result := 'A';
    $B0C5..$B2C0 : result := 'B';
    $B2C1..$B4ED : result := 'C';
    $B4EE..$B6E9 : result := 'D';
    $B6EA..$B7A1 : result := 'E';
    $B7A2..$B8C0 : result := 'F';
    $B8C1..$B9FD : result := 'G';
    $B9FE..$BBF6 : result := 'H';
    $BBF7..$BFA5 : result := 'J';
    $BFA6..$C0AB : result := 'K';
    $C0AC..$C2E7 : result := 'L';
    $C2E8..$C4C2 : result := 'M';
    $C4C3..$C5B5 : result := 'N';
    $C5B6..$C5BD : result := 'O';
    $C5BE..$C6D9 : result := 'P';
    $C6DA..$C8BA : result := 'Q';
    $C8BB..$C8F5 : result := 'R';
    $C8F6..$CBF9 : result := 'S';
    $CBFA..$CDD9 : result := 'T';
    $CDDA..$CEF3 : result := 'W';
    $CEF4..$D188 : result := 'X';
    $D1B9..$D4D0 : result := 'Y';
    $D4D1..$D7F9 : result := 'Z';
  else
    result := char(0);
  end;
end;

function SearchByPYIndexStr(SourceStrs:TStrings;PYIndexStr:string):string;
label NotFound;
var
  i, j   :integer;
  hzchar :string;
begin
  for i:=0 to SourceStrs.Count-1 do
    begin
      for j:=1 to Length(PYIndexStr) do
        begin
          hzchar:=SourceStrs[i][2*j-1]+SourceStrs[i][2*j];
          if (PYIndexStr[j]<>'?') and  (UpperCase(PYIndexStr[j]) <>
            GetPYIndexChar(hzchar)) then
            goto NotFound;
         end;
      if result='' then
        result := SourceStrs[i]
      else
        result := result + Char(13) + SourceStrs[i];
      NotFound:
    end;
end;


end.