ugeneralfunc.pas

是一个用delphi设计的考勤系统

      CloseFile(fplog);
    end;
   //****************************************************
  except
    application.messagebox('请设定系统日志路经:logpath', '系统提示', mb_ok + mb_iconstop);
  end;
end;

function Replace(S: string; const SubStr, ReplaceStr: string): string;
var
  Position: integer;
  Len: integer;
begin
  Len := length(s);
  if len = 0 then exit;
  while (pos(substr, s) > 0) and (Pos(substr, s) <= len) do
  begin
    position := pos(substr, s);
    s := copy(s, 1, position - 1) + ReplaceStr + copy(s, position + 1, len - position);
  end;
  result := s;
end;

procedure SetWindowSize(AForm: Tform);
begin
  with TForm(AForm) do
  begin
    Left := 0;
    Top := 0;
    ClientWidth := Screen.Width;
    ClientHeight := Screen.Height;
  end;
end;

procedure SetCenterOfWindow(AForm: Tform);
begin
  with TForm(AForm) do
  begin
    Left := (Screen.Width - width) div 2;
    Top := (Screen.Height - height) div 2;
  end;
end;

procedure LoadImage(AImage: Timage; ImageFileName: string);
var
  TempPath: string;
begin
  TempPath := GetCurrentDir + ImageFileName;
  try
    AImage.Picture.LoadFromFile(TempPath);
  except
    on EInvalidGraphic do
      AImage.Picture.Graphic := nil;
  end;
end;

function Sound(const SoundFileName: string; const soundnil: boolean): boolean;
var
  targetpath: string;
begin
  targetpath := GetCurrentDir + SoundFileName;
  try
    if not (soundnil) then playsound(nil, 0, 0);
    playsound(pchar(targetpath), 0, snd_filename or snd_async or snd_nodefault);
    result := true;
  except
    result := false;
  end;
end;

procedure FillSpace(s: pchar; bufflen: integer);
begin
  strcat(s, pchar(stringofchar(' ', bufflen - strlen(s) - 1)));
end;

function Encode(const Data: string; Depth: Word): string; //加密
var
  i: integer;
begin
  Result := Data;
  if length(Data) <> 0 then
    for I := 0 to Length(Data) do
    begin
      Result[I] := char(byte(Data[I]) xor (Depth shr 13));
      Depth := (byte(Result[I]) + Depth) * C1 + C2;
    end;
end;

function Decode(const Data: string; Depth: Word): string;
//'解密
var
  i: integer;
begin
  Result := Data;
  if length(Data) <> 0 then
    for I := 0 to Length(Data) do
    begin
      Result[I] := char(byte(Data[I]) xor (Depth shr 13));
      Depth := (byte(Data[I]) + Depth) * C1 + C2;
    end;
end;

function SplitString(Tempstr: string; var RetArray: DynamicA; sign: string): integer;
var
  ipos, iIndex: integer;
begin
  result := 0;
  iIndex := 0;
  while (pos(sign, Tempstr) > 0) or (length(Tempstr) > 0) do
  begin
    iPos := pos(sign, Tempstr);
    if iPos = 0 then
      iPos := length(Tempstr) + 1;
    if high(RetArray) <= iIndex then
      setlength(RetArray, iIndex + 1);
    RetArray[iIndex] := copy(Tempstr, 1, iPos - 1);
    inc(iIndex);
    delete(Tempstr, 1, iPos);
  end;
  result := iIndex;
end;

function CheckDate(strdate: string): boolean;
var
  viYear, viMonth, viDay: integer;
  viTYear, viTMonth, viTDay: word;
begin
  Result := true;
  if (length(strdate) = 8) or (length(strdate) = 6) then
  else
  begin
    result := false;
    exit;
  end;
  viYear := strtoint(copy(strdate, 1, 4));
  viMonth := Strtoint(copy(strdate, 5, 2));
  if length(strdate) = 8 then
    viDay := strtoint(copy(strdate, 7, 2));
  if length(strdate) = 6 then
    viDay := strtoint('01');
  DecodeDate(now, viTYear, viTMonth, ViTDay);
  if (viYear < 1980) or (viYear > viTYear) or (viMonth = 0) or (viMonth > 12) or (viDay = 0)
    or ((viMonth in [1, 3, 5, 7, 8, 10, 12]) and (viDay > 31)) or ((viMonth in [2, 4, 6, 9, 11]) and (viDay > 30))
    then
  begin
    Result := false;
    Exit;
  end;
  if viMonth = 2 then
  begin
    if (viYear mod 4) = 0 then
    begin
      if viDay > 29 then
      begin
        Result := false;
        exit;
      end;
    end
    else
    begin
      if viDay > 28 then
      begin
        Result := false;
        exit;
      end;
    end;
  end;
end;

function NumberToAscii(Number: integer): string;
begin
  case Number of
    0, 1, 2, 3, 4, 5, 6, 7, 8, 9: Result := inttostr(Number);
    10: Result := 'A';
    11: Result := 'B';
    12: Result := 'C';
    13: Result := 'D';
    14: Result := 'E';
    15: Result := 'F';
  end;
end;

function NumberToHex(Number: integer): string;
var
  FirstBit, SecondBit: integer;
begin
  if Number = 0 then
    result := '00'
  else
  begin
    FirstBit := Number div 16;
    SecondBit := Number mod 16;
    result := NumberToAscii(FirstBit) + NumberToAscii(SecondBit);
  end;
end;

procedure LoadTreeData(AdoConnection: TAdoConnection; Atrview: TTreeView; RootCaption: string; const ASqltxt: string;
  const ACodeField: string; const AFieldDescribe: string; const AiDescribeMode: integer = 0);
var
  pTreeNode: m_ptTreeNode;
  treeNode1, treeNode2: TTreeNode;
  Query1: TAdoQuery;
begin
  Atrview.Items.Clear;
  Query1 := TAdoQuery.Create(Screen.activeForm);
  Query1.Connection := AdoConnection;
  with Query1 do
  begin
    sql.clear;
    sql.add(ASqltxt);
    open;
  end;
  if Query1.Recordcount = 0 then exit;
  try
    New(pTreeNode);
    pTreeNode^.nodeValue := 'ROOT';
    TreeNode1 := Atrview.Items.AddChildObject(nil, RootCaption, pTreeNode);
    while not Query1.eof do
    begin
      New(pTreeNode);
      pTreeNode^.nodeValue := 'a' + Query1.fieldbyname(ACodeField).asstring;
      case AiDescribeMode of
        0: Atrview.Items.AddChildObject(TreeNode1,
            Query1.fieldbyname(AFieldDescribe).asstring, pTreeNode);
        1: Atrview.Items.AddChildObject(TreeNode1,
            Query1.fieldbyname(ACodeField).asstring + ':' +
            Query1.fieldbyname(AFieldDescribe).asstring, pTreeNode);
      end;
      Query1.Next;
    end;
    New(pTreeNode); //必须否则最后的代码成为空值?
  finally
    Query1.free;
    dispose(pTreeNode);
  end;
end;

function BstrtoInt(str: string): integer; //二进字符串转换为十进整型
var
  i: integer;
  ret: integer;
begin
  ret := 0;
  for i := 1 to length(str) - 1 do
  begin
    ret := (ret + strtoint(copy(str, i, 1))) * 2
  end;
  ret := ret + strtoint(copy(str, length(str), 1));
  BstrtoInt := ret;
end;

function InttoBstr(value: integer; Digits: integer): string; //十进整型转换为二进字符串
var
  str: string;
  i: integer;
begin
  str := '';
  for i := 1 to digits do
  begin
    str := inttostr(value mod 2) + str;
    value := value div 2;
  end;
  InttoBstr := str;
end;

procedure SplitMoney(const AMoney: string; var AUpperMoney: string; var Asw, Aw, Aq, Ab, Asi, Ay, Aj, Af: string);
var
  bridge: string[8];
  i: integer;
begin
  AUpperMoney := GetLowToUpper(AMoney);
  bridge := floattostr(strtofloat(AMoney) * 100);
  for i := 1 to 8 - length(bridge) do
  begin
    bridge := '0' + bridge;
  end;
  for i := 1 to 8 do
  begin
    case i of
      1: Asw := copy(bridge, i, 1);
      2: Aw := copy(bridge, i, 1);
      3: Aq := copy(bridge, i, 1);
      4: Ab := copy(bridge, i, 1);
      5: Asi := copy(bridge, i, 1);
      6: Ay := copy(bridge, i, 1);
      7: Aj := copy(bridge, i, 1);
      8: Af := copy(bridge, i, 1);
    end;
  end;
end;

function DispWeek: string;
var
  w: integer;
  week: string;
begin
  w := DayOfWeek(date);
  case w of
    1: week := '日';
    2: week := '一';
    3: week := '二';
    4: week := '三';
    5: week := '四';
    6: week := '五';
    7: week := '六';
  end; {case}
  Result := '星期' + week;
end;

procedure SaveCommLog(ATestStr: pchar; ADirectory: string);
var
  FpLog: textfile;
  CommText: string;
begin
  setlength(CommText, sizeof(ATestStr));
  CommText := strpas(ATestStr);
  try
    //*****日志处理*****************************************
    if not DirectoryExists(ADirectory) then
      CreateDir(ADirectory);
    ADirectory := ADirectory + '\' + DateToStr(date) + '.txt';
    try
      AssignFile(fplog, ADirectory);
      if not FileExists(ADirectory) then
        Rewrite(fplog)
      else
        Append(fplog);
      Writeln(fplog, format('%s,%s※%s', [datetostr(date),timetostr(now), CommText]));
    finally
      CloseFile(fplog);
    end;
   //****************************************************
  except
    application.messagebox('请设定系统日志路经:logpath', '系统提示', mb_ok + mb_iconstop);
  end;
end;


function CreateMutex(lpMutexAttributes: PSecurityAttributes; bInitialOwner: BOOL; lpName: PChar): THandle;
begin
  Result := _CreateMutex(lpMutexAttributes, Integer(Boolean(bInitialOwner)), lpName);
end;

function DecipherRandomPassWord(var RandomPassWord: string; const iYhsl:integer; var iSysbh: integer;
  var iSector: integer; var sMSysCardPWD: string; var sSysPassWord: string): boolean;
var
  mSumCount: integer;
  mSysbhCount: integer;
  mMsysCardPWDCount: integer;
  mSysPassWordCount: integer;
  i: integer;
  tmp: integer;
begin
  result := False;
  try
    if length(RandomPassWord) <> 38 then exit;
    mSumCount := strtoint(copy(RandomPassWord, 1, 4))-iYhsl;
    mSysbhCount := strtoint(copy(RandomPassWord, 5, 2));
    mMsysCardPWDCount := strtoint(copy(RandomPassWord, 14, 2));
    mSysPassWordCount := strtoint(copy(RandomPassWord, 36, 3));
    tmp := 0;
    for i := 5 to 38 do tmp := tmp + strtoint(copy(RandomPassWord, i, 1));
    if mSumCount<>tmp then exit;
    tmp := 0;
    for i := 7 to 11 do tmp := tmp + strtoint(copy(RandomPassWord, i, 1));
    if mSysbhCount <> tmp then exit;
    iSysBh := strtoint(copy(RandomPassWord, 7, 5));
    //
    tmp := 0;
    for i := 16 to 23 do tmp := tmp + strtoint(copy(RandomPassWord, i, 1));
    if mMsysCardPWDCount <> tmp then exit;
    sMsysCardPWD := copy(RandomPassWord, 16, 8);
    //
    tmp := 0;
    for i := 24 to 35 do tmp := tmp + strtoint(copy(RandomPassWord, i, 1));
    if mSysPassWordCount <> tmp then exit;
    sSysPassWord := copy(RandomPassWord, 24, 12);
    //
    iSector := strtoint(copy(RandomPassWord, 12, 2)) - mSysbhCount;
    result := True;
  except
  end;
end;

function EncryptRandomPassWord(var RandomPassWord: string;
   iYhsl:integer;
   iSysbh: integer;
   iSector: integer;
   sMSysCardPWD: string;
   sSysPassWord: string): boolean;
var
  mSumCount: integer;
  mSysbhCount: integer;
  mMsysCardPWDCount: integer;
  mSysPassWordCount: integer;
  i: integer;
  tmp: string;
begin
  result := False;
  try
    //系统编号
    tmp := inttostr(iSysbh);
    for i:= 1 to 5 - length(tmp) do tmp := '0' + tmp;
    mSysbhCount := 0;
    for i := 1 to 5 do mSysbhCount := mSysbhCount + strtoint(copy(tmp, i, 1));
    RandomPassWord:=tmp;
    tmp:=inttostr(mSysbhCount);
    for i:= 1 to 2 - length(tmp) do tmp := '0' + tmp;
    RandomPassWord:=tmp+RandomPassWord;
    //系统扇区号
    tmp:=inttostr(mSysbhCount+iSector);
    for i:= 1 to 2 - length(tmp) do tmp := '0' + tmp;
    RandomPassWord:=RandomPassWord+tmp;
    //母系统卡密码
    tmp:=sMsysCardPWD;
    for i:= 1 to 8 - length(sMSysCardPWD) do tmp := '0' + tmp;
    mMsysCardPWDCount := 0;
    for i := 1 to 8 do mMsysCardPWDCount := mMsysCardPWDCount + strtoint(copy(tmp, i, 1));
    tmp:=inttostr(mMsysCardPWDCount)+tmp;
    for i:=1 to 10-length(tmp) do tmp:='0'+tmp;
    RandomPassWord:=RandomPassWord+tmp;
    //系统密码
    tmp:=sSysPassWord;
    for i:= 1 to 12 - length(sSysPassWord) do tmp := '0' + tmp;
    RandomPassWord:=RandomPassWord+tmp;
    mSysPassWordCount := 0;
    for i := 1 to 12 do mSysPassWordCount := mSysPassWordCount + strtoint(copy(tmp, i, 1));
    tmp:=inttostr(mSysPassWordCount);
    for i:=1 to 3-length(tmp) do tmp:='0'+tmp;
    RandomPassWord:=RandomPassWord+tmp;
    //总和
    mSumCount:=0;
    for i:=1 to 34 do mSumCount:=mSumCount+strtoint(copy(RandomPassWord,i,1));
    tmp:=inttostr(mSumCount+iYhsl);
    for i:=1 to 4-length(tmp) do tmp:='0'+tmp;
    RandomPassWord:=tmp+RandomPassWord;
    result := True;
  except
  end;
end;
end.