commfunc.pas

电力行业前台收费程序,需要有后台SQL数据库,和电费管理系统配合应用.

unit Commfunc;

interface

uses Dialogs,Windows,Messages,classes,SysUtils, DB,DCPcrypt, SHA1,Forms;

const
  PowerLen=10;  //用户权限字符串长度
  C1=513325;//密匙
  C2=391712;
  PassKey       = 'gs2002';
  
  type TStrIDRec=record
    ID:Integer;
    Str:String;
  end;

  procedure SetLocalSystemTime(NewTime: TDateTime);  //设置系统时间
  procedure KillMessage(Wnd: HWnd; Msg: Integer);
  procedure CutStr(MStr:String;Var ResultList:TStringList;CutChar:Char);
  function ListToStr(StrLst:TStrings;CutChar:String):String;
  procedure UnSqlStr(SqlStr:String;StrLst:TStrings);
  procedure XChgCaseSQL(SqlStr:String;StrLst:TStrings);
  function StrIPos(const Str1, Str2: PChar): PChar;
  function GetFileName(FName:String):String;
  function Decrypt(const S:ShortString;Key:Word):ShortString;
  function EncrypPassword(DbSeting:String;OnlyHide:Boolean):String;
  function UncrypKeyPassword(DbSeting:String):String;
  function EncrypKey (Src:String; Key:String):string;
  Function UncrypKey (Src:String; Key:String):string;
  function HashPasswordForStoringInConfigFile(Password:String;PasswordFormat:String):String;
  function HaveThesePower(OpID:Integer;TableName:PChar;PowerFld:PChar):Integer;
var
  IniFileName : String;
  AppPath     : String;
  ExtAppPath  : String;
implementation
uses DataMod;

procedure SetLocalSystemTime(NewTime: TDateTime);
var
 tST: TSystemTime;
begin
  NewTime:=NewTime-1/24*8;//中国在第八时区,所以要从格林威置时间中减8小时
  DateTimeToSystemTime(NewTime,tST);
  SetSystemTime(tST);
end;

procedure KillMessage(Wnd: HWnd; Msg: Integer);
var
  M: TMsg;
begin
  M.Message := 0;
  if PeekMessage(M, Wnd, Msg, Msg, pm_Remove) and (M.Message = WM_QUIT) then
    PostQuitMessage(M.wparam);
end;

procedure CutStr(MStr:String;Var ResultList:TStringList;CutChar:Char);
var
  SPos,BPos,SLen:Integer;
  ChkChr:^Char;
begin
  ChkChr:=Pointer(MStr);
  SLen:=Length(MStr);
  SPos:=1;BPos:=1;ResultList.Clear;
  while SPos<=SLen do begin
    if ChkChr^=CutChar then begin
      if SPos>BPos then begin
        ResultList.Add(Copy(MStr,BPos,SPos-BPos));
        BPos:=SPos+1;
        SPos:=BPos;
        Inc(ChkChr);
      end
      else begin
        Inc(SPos);
        Inc(BPos);
        Inc(ChkChr);
      end;
    end
    else
      begin
        Inc(SPos);
        Inc(ChkChr);
      end;
  end;
  if SPos>BPos then
    ResultList.Add(Copy(MStr,BPos,SPos-BPos))
end;

function ListToStr(StrLst:TStrings;CutChar:String):String;
var
  I:Integer;
begin
  Result:='';
  for I:=0 to StrLst.Count-2 do
    Result:=Result+StrLst.Strings[I]+CutChar;
  if StrLst.Count>=2 then
    Result:=Result+StrLst.Strings[StrLst.Count-1];
end;

//切分的SQL语句依次为select;from;where;order by;group by
procedure UnSqlStr(SqlStr:String;StrLst:TStrings);
var
  StrArr:Array[0..4] of String;
  SelectPtr:PChar;
  I,J:Integer;
begin
  StrLst.Clear;
  StrArr[0]:=SqlStr;
  SelectPtr:=Pchar(StrArr[0]);
  StrArr[1]:=StrIPos(SelectPtr,'FROM');
  StrArr[2]:=StrIPos(SelectPtr,'WHERE');
  StrArr[3]:=StrIPos(SelectPtr,'ORDER');
  StrArr[4]:=StrIPos(SelectPtr,'GROUP');
  for I:=0 to 3 do
    if StrArr[I]='' then
      StrLst.Add(StrArr[I])
    else begin
      for J:=I+1 to 3 do
        if StrArr[J]<>'' then
          Break;
      if StrArr[J]<>'' then
        StrLst.Add(Copy(StrArr[I],1,StrLen(PChar(StrArr[I]))-StrLen(PChar(StrArr[J]))))
      else
        StrLst.Add(StrArr[I]);
    end;
  StrLst.Add(StrArr[4]);
end;

procedure XChgCaseSQL(SqlStr:String;StrLst:TStrings);
var
  BaseStr,ResultSQL:Array[0..1023] of Char;
  SubSqlStr:Array[0..512] of char;
  I,ResPos,Pos:Integer;
  Flag:Boolean;
  Para:Char;
begin
  StrCopy(BaseStr,Pchar(SqlStr));
  Flag:=False;Pos:=0;ResPos:=0;Para:='A';
  for I:=0 to Length(SqlStr) do begin
    if BaseStr[I]='(' then begin
      Flag:=True;
      Pos:=I;
      ResultSQL[ResPos]:=':';
      Inc(ResPos);
      ResultSQL[ResPos]:=Para;
      Inc(ResPos);
      Inc(Para);
    end
    else
      if Flag then begin
        if BaseStr[I]=')' then begin
          Flag:=False;
          SubSqlStr[I-Pos-1]:=#0;
          StrLst.Add(SubSqlStr);
          SubSqlStr:='';
        end
        else
          SubSqlStr[I-Pos-1]:=BaseStr[I];
      end
      else begin
        ResultSQL[ResPos]:=BaseStr[I];
        Inc(ResPos);
      end;
  end;
  if SubSqlStr<>'' then
    StrLst.Add(SubSqlStr);
  StrLst.Add(ResultSQL);
end;

function StrIPos(const Str1, Str2: PChar): PChar;
var
  TmpPos:Integer;
begin
  TmpPos:=Pos(UpperCase(Str2),UpperCase(Str1));
  asm
    mov ECX,Str1;
    Add ECX,TmpPos;
    DEC ECX;
    mov Result,ECX;
  end;
end;

function GetFileName(FName:String):String;
begin
  if StrScan(PChar(Result),'.')=nil then
    Result:=FName
  else begin
    Result:=ExtractFileName(FName);
    StrScan(PChar(Result),'.')^:=#0;
  end;
end;

function Decrypt(const S:ShortString;Key:Word):ShortString;
var
  I,CryVal:byte;
  TmpStr:ShortString;
begin
  TmpStr:='';
  for I:=1 to length(S) div 2 do begin
    CryVal:=byte(StrToInt('$'+S[I*2-1]+S[I*2]));
    TmpStr:=TmpStr+Char(CryVal xor (Key shr 8));
    Key:=(CryVal+Key)*C1+C2;
  end;
  Result:=TmpStr;
end;

function EncrypPassword(DbSeting:String;OnlyHide:Boolean):String;
var{将连接中的密码字段加密}
  TempList1,TempList2:TStringList;
  I:Integer;
begin
  TempList1:=TStringList.Create;
  TempList2:=TStringList.Create;
  CutStr(DbSeting,TempList1,';');
  Result:='';
  for I:=0 to TempList1.Count-1 do begin
    CutStr(TempList1.Strings[I],TempList2,'=');
    if UpperCase(Trim(TempList2.Strings[0]))<>'PASSWORD' then begin
      Result:=Result+TempList1.Strings[I];
      if I<TempList1.Count-1 then
        Result:=Result+';';
    end
    else begin
      if OnlyHide then
        Continue;
      if TempList2.Count<2 then
        TempList2.Add('""');
      TempList2.Strings[1]:=EncrypKey(TempList2.Strings[1],PassKey);
      Result:=Result+TempList2.Strings[0]+'='+TempList2.Strings[1]+';';
    end;
  end;
  TempList2.Free;
  TempList1.Free;
end;

function UncrypKeyPassword(DbSeting:String):String;
var{将数据库连接字符串中的密码字段解密}
  TempList1,TempList2:TStringList;
  I:Integer;
begin
  TempList1:=TStringList.Create;
  TempList2:=TStringList.Create;
  CutStr(DbSeting,TempList1,';');
  Result:='';
  for I:=0 to TempList1.Count-1 do begin
    CutStr(TempList1.Strings[I],TempList2,'=');
    if UpperCase(Trim(TempList2.Strings[0]))<>'PASSWORD' then begin
      Result:=Result+TempList1.Strings[I];
      if I<TempList1.Count-1 then
        Result:=Result+';';
    end
    else begin
      if TempList2.Count<2 then
        TempList2.Add('""');
      TempList2.Strings[1]:=UncrypKey(TempList2.Strings[1],PassKey);
      Result:=Result+TempList2.Strings[0]+'='+TempList2.Strings[1]+';';
    end;
  end;
  TempList2.Free;
  TempList1.Free;
end;

function EncrypKey (Src:String; Key:String):string;
var{字符串加密函数}
//  idx :integer;
  KeyLen :Integer;
  KeyPos :Integer;
  offset :Integer;
  dest :string;
  SrcPos :Integer;
  SrcAsc :Integer;
//  TmpSrcAsc :Integer;
  Range :Integer;
begin
  KeyLen:=Length(Key);
  if KeyLen = 0 then key:='y#1@U3D';
  KeyPos:=0;
//  SrcPos:=0;
//  SrcAsc:=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 UncrypKey (Src:String; Key:String):string;
var{字符串解密函数}
//  idx :integer;
  KeyLen :Integer;
  KeyPos :Integer;
  offset :Integer;
  dest :string;
  SrcPos :Integer;
  SrcAsc :Integer;
  TmpSrcAsc :Integer;
//  Range :Integer;
begin
  KeyLen:=Length(Key);
  if KeyLen = 0 then key:='y#1@U3D';
  KeyPos:=0;
//  SrcPos:=0;
//  SrcAsc:=0;
//  Range:=256;
  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 HashPasswordForStoringInConfigFile(Password:String;PasswordFormat:String):String;
var
  DCP_Hash:TDCP_Hash;
  HashDigest:array[0..31] of byte;
  I:Integer;
begin{哈希加密函数，兼容.Net中的函数，暂时只支持SHA1}
  if UpperCase(PasswordFormat)='SHA1' then
    DCP_Hash:=TDCP_Sha1.Create(nil)
  else
    Exit;
  with DCP_Hash do begin
    Init;
    UpdateStr(Password);
    Final(HashDigest);
    Result:='';
    for I:=0 to ((HashSize div 8)-1) do
      Result:=Result+IntToHex(HashDigest[I],2);
    Free;
  end;
end;

function HaveThesePower(OpID:Integer;TableName:PChar;PowerFld:PChar):Integer;
var{权限校验}
  PowerList,TempList:TStringList;
  I:Integer;
begin
  if OpID<0 then
    Result:=0
  else with DataMD do begin
    if OpenQuery('select 权限 from '+TableName+' where ID='+IntToStr(OpID)).RecordCount=0 then begin
       ADOQueryPub.Close;
       Result:=0;
    end
    else begin
      PowerList:=TStringList.Create;
      CutStr(PowerFld,PowerList,';');
      TempList:=TStringList.Create;
      CutStr(ADOQueryPub.Fields[0].AsString,TempList,';');
      Result:=1;
      for I:=0 to PowerList.Count-1 do
        if TempList.IndexOf(PowerList.Strings[I])=-1 then begin
          Result:=0;
          Break;
        end;
    end;
  end;
end;

initialization
  AppPath:=ExtractFilePath(Application.ExeName);
  IniFileName:=ChangeFileExt(Application.ExeName,'.Ini');
  ExtAppPath:=AppPath+'Extend\';
end.