ugeneralfunc.pas

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

{
***************************************************************
*  说明：通用函数单元                                           *
***************************************************************
}
unit UGeneralFunc;

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ADODB, Db, Dbtables, ComCtrls, mmsystem, winsock, Clipbrd, shellapi, UTSysCs;


type
  TGetFieldValues = string[50];
  DynamicA = array of string; //定义动态数组
var
  m_aGetFieldValues: array[0..30] of TGetFieldValues; //返回记录字段数组数值
//判断表中是否存在一个符合条件的记录
function GetRecord(AtQuery: TAdoQuery; const ASqltxt: string): boolean;
//通过一个SQL语句把查询到的字段值付给一个数组
function GetArrFieldValues(AdoConnection: TAdoConnection;
  const ASqltxt: string;
  var asFValue: array of TGetFieldValues): Integer;
//查询某个字段的值
function GetFieldValue(AdoConnection: TAdoConnection; const ASqltxt, asRetField: string): string;
//执行一条SQL语句
procedure ExecQuery(AdoConnection: TAdoConnection; const ASqltxt: string);
{显示对话框函数(参数msg:提示信息，Adialog:为0是对话框为1时是确认框,
 参数AIcon:为0时显示信息图标为1时显示提问图标为2显示警告图标，参数Adefbutton添加按钮)
 选择确认时本函数返回true
 }
function ShowMsg(const Msg: string;
  const Adialog, AIcon: Integer; Adefbutton: integer = 1): boolean;
{查询表中某个字段的值并把所查到的值添加到Combox框中
 （参数1：Ado连接，参数2：Tcombobox，参数3：Sql字符串,参数4：字段名)
}
procedure SetComboxItems(AdoConnection: TAdoConnection; AComboBox: TComboBox;
  ASqltxt: string; AField: string);
//金额转为中文大写函数最高限额为十万
function GetLowToUpper(const strone: string): string;
//左补零函数 (参数1：要填补的字符串，参数2：总长度)
function GetFillZeroStr(AStr: string; Len: integer): string;
// AscII转换
procedure Ascii0ToSpace(p: pointer; Len: integer);
//写日志（参数1：日志内容，参数2：日志文本所要保存的路径)
procedure WriteLog(ATestStr: pchar; ADirectory: string);
//替换子字符串函数(参数1：字符串，参数2：被替换的子串，参数3：替换字符串）
function Replace(S: string; const SubStr, ReplaceStr: string): string;
//设置窗体的大小
procedure SetWindowSize(AForm: Tform);
//设置窗体在屏幕中间显示
procedure SetCenterOfWindow(AForm: Tform);
//Image控件的图片装载 (参数1：控件，参数2：应用程序路径的子目录下的图片文件）
procedure LoadImage(AImage: Timage; ImageFileName: string);
//声音播放函数(参数1：声音文件，参数2：是否终止其它正在播放的声音)
function Sound(const SoundFileName: string; const soundnil: boolean): boolean;
//补空格函数（参数1：字符串，参数2：总长度）
procedure FillSpace(s: pchar; bufflen: integer);
//字符串加密函数（参数1：要加密的字符数据，参数2：加密深度(0~256))
function Encode(const Data: string; Depth: Word): string; //加密
//字符串解密函数（参数1：要解密的字符数据，参数2：解密深度(0~256))
function Decode(const Data: string; Depth: Word): string;
//分解字符串(Tempstr要分解的字符串，Retarray返回的数组，sign分隔符)
function SplitString(Tempstr: string; var RetArray: DynamicA; sign: string): integer;
//检查日期的准确性
function CheckDate(strdate: string): boolean;
//将(0-15)数值型转换成十六进制一位ASCII值
function NumberToAscii(Number: integer): string;
//将一个数值型转变成十六进制(二位ASCII)如：A0等
function NumberToHex(Number: integer): string;
{通过Sql查询语句设置树型分支值
 （参数1：Ado连接，参数2：树型控件，参数3：树型根目录名称，参数4：SQL语句
   参数5：代码字段名，参数6：注释字段名，参数7：显示方式为0只显示注释字段值为1显示代码字段值加注释）
}
procedure LoadTreeData(AdoConnection: TAdoConnection; Atrview: TTreeView; RootCaption: string; const ASqltxt: string;
  const ACodeField: string; const AFieldDescribe: string; const AiDescribeMode: integer = 0);
//二进字符串转换为十进整型
function BstrtoInt(str: string): integer;
//十进整型转换为二进字符串
function InttoBstr(value: integer; Digits: integer): string;
//对金额值进行分解到各个变量中
procedure SplitMoney(const AMoney: string; var AUpperMoney: string; var Asw, Aw, Aq, Ab, Asi, Ay, Aj, Af: string);
//中文星期几函数
function DispWeek: string;
procedure SaveCommLog(ATestStr: pchar; ADirectory: string);
//调用Help文件

function HtmlHelp(hwd: Integer; pszFile: string; uCommand: Integer;
  dwData: LongInt): Integer; stdcall; external 'HHCtrl.ocx' name 'HtmlHelpA';

function GetLastError: integer; stdcall external 'kernel32.dll' name 'GetLastError';
function _CreateMutex(lpMutexAttributes: PSecurityAttributes;
  bInitialOwner: Integer; lpName: PChar): THandle; stdcall; external kernel32 name 'CreateMutexA';

function CreateMutex(lpMutexAttributes: PSecurityAttributes; bInitialOwner: BOOL; lpName: PChar): THandle; stdcall;
//procedure ZxRpt(handle: thandle);stdcall; external 'Report.dll' name 'ZxRpt';

//; dwmc: pchar; zbbm: pchar; usrdm: pchar); stdcall; external 'ReportDll.dll' name 'ZxRpt'
//解释随机密码
function DecipherRandomPassWord(var RandomPassWord: string;
  const iYhsl:integer;
  var iSysbh: integer;
  var iSector: integer;
  var sMSysCardPWD: string;
  var sSysPassWord: string): boolean;
//产生随机密码
function EncryptRandomPassWord(var RandomPassWord: string;
      iYhsl:integer;
      iSysbh: integer;
      iSector: integer;
      sMSysCardPWD: string;
      sSysPassWord: string): boolean;

implementation

type
  m_ptTreeNode = ^TTreeData; //树型控件节点值结构指针变量
  TTreeData = record
    NodeValue: string;
  end;

const
  C1 = 51317;
  C2 = 18705;

function GetRecord(AtQuery: TAdoQuery; const ASqltxt: string): boolean;
begin
  result := false;
  with AtQuery do
  begin
    close;
    sql.Clear;
    sql.add(ASqltxt);
    open;
  end;
  if AtQuery.RecordCount > 0 then
    result := true;
end;

function GetArrFieldValues(AdoConnection: TAdoConnection;
  const ASqltxt: string;
  var asFValue: array of TGetFieldValues): Integer;
{ 运行一条Sql查询语句 }
var
  Query: TAdoQuery;
  iFIndex, iFCount: Integer;
begin
  Result := 0;
  if (AdoConnection <> nil) and (ASqltxt <> '') then
  begin
    Query := TAdoQuery.Create(Screen.ActiveForm);
    Query.Connection := AdoConnection;
    try
      try
        with Query do
        begin
          Sql.Add(ASqltxt);
          Open;
          Result := RecordCount;
          if Result > 0 then
          begin
            iFCount := FieldCount - 1;
            if iFCount > (High(asFValue) - Low(asFValue)) then
              iFCount := High(asFValue) - Low(asFValue);
            for iFIndex := 0 to iFCount do
              asFValue[iFindex + Low(asFValue)] := Fields[iFIndex].AsString;
          end;
          Close;
        end;
      except
        Result := -1;
      end;
    finally
      Query.Destroy;
    end;
  end;
end;

function GetFieldValue(AdoConnection: TAdoConnection; const ASqltxt, asRetField: string): string;
var
  Query: TAdoQuery;
begin
  Result := '';
  if (AdoConnection <> nil) and (ASqltxt <> '') then
  begin
    Query := TAdoQuery.Create(Screen.ActiveForm);
    Query.Connection := AdoConnection;
    try
      with Query do
      begin
        close;
        sql.Clear;
        Sql.Add(ASqltxt);
        Open;
        if RecordCount > 0 then result := fieldbyname(asRetField).asstring;
      end;
    finally
      Query.Destroy;
    end;
  end;
end;

procedure ExecQuery(AdoConnection: TAdoConnection; const ASqltxt: string);
var
  query: TAdoQuery;
begin
  query := TAdoQuery.create(screen.activeform);
  try
    with query do
    begin
      Connection := AdoConnection;
      close;
      sql.Clear;
      sql.add(ASqltxt);
      execsql;
    end;
  finally
    query.free;
  end;
end;

function ShowMsg(const Msg: string;
  const Adialog, AIcon: Integer; Adefbutton: integer = 1): boolean;
begin
  result := false;
  case Adialog of
    0:
      begin
        if Adefbutton = 1 then
        begin
          case AIcon of
            0:
              if application.messagebox(pchar(msg),
                '系统提示', mb_okcancel + mb_defbutton1 + mb_iconinformation) = id_ok then
                result := true;
            1:
              if application.messagebox(pchar(msg),
                '系统提示', mb_okcancel + mb_defbutton1 + mb_iconquestion) = id_ok then
                result := true;
            2:
              if application.messagebox(pchar(msg),
                '系统提示', mb_okcancel + mb_defbutton1 + mb_iconwarning) = id_ok then
                result := true;
          end;
        end
        else begin
          case AIcon of
            0:
              if application.messagebox(pchar(msg),
                '系统提示', mb_okcancel + mb_defbutton2 + mb_iconinformation) = id_ok then
                result := true;
            1:
              if application.messagebox(pchar(msg),
                '系统提示', mb_okcancel + mb_defbutton2 + mb_iconquestion) = id_ok then
                result := true;
            2:
              if application.messagebox(pchar(msg),
                '系统提示', mb_okcancel + mb_defbutton2 + mb_iconwarning) = id_ok then
                result := true;
          end;
        end;
      end;
    1:
      begin
        case AIcon of
          1:
            application.messagebox(pchar(msg), '系统提示', mb_ok + mb_iconquestion);
          2:
            application.messagebox(pchar(msg), '系统提示', mb_ok + mb_iconwarning);
        else
          application.messagebox(pchar(msg), '系统提示', mb_ok + mb_iconinformation);
        end;
        result := true;
      end;
  end;
end;

procedure SetComboxItems(AdoConnection: TAdoConnection; AComboBox: TComboBox;
  ASqltxt: string; AField: string);
var
  QuryTemp: TAdoQuery;
begin
  try
    AComboBox.Clear;
    QuryTemp := TAdoQuery.create(nil);
    with QuryTemp do
    begin
      close;
      Connection := AdoConnection;
      sql.Clear;
      sql.add(ASqltxt);
      open;
      if recordcount = 0 then exit;
      first;
      while not eof do
      begin
        AComboBox.items.add(fieldbyname(AField).asstring);
        next;
      end;
    end;
  finally
    QuryTemp.Free;
  end;
end;

function GetLowToUpper(const strone: string): string;
var
  bridge: string[6];
  point: string[2];
  i, tmpint: integer;
  zeroflag: boolean;
begin
  result := '';
  bridge := copy(strone, 1, pos('.', strone) - 1);
  point := copy(strone, pos('.', strone) + 1, 2);
  for i := 1 to 6 - length(bridge) do
  begin
    bridge := '0' + bridge;
  end;
  zeroflag := true;
  for i := 1 to 6 do
  begin
    tmpint := strtoint(copy(bridge, i, 1));
    if tmpint > 0 then zeroflag := false;
    case tmpint of
      0: begin
          if zeroflag = true then
            result := result + '×'
          else
            result := result + '零';
        end;
      1: result := result + '壹';
      2: result := result + '贰';
      3: result := result + '叁';
      4: result := result + '肆';
      5: result := result + '伍';
      6: result := result + '陆';
      7: result := result + '柒';
      8: result := result + '捌';
      9: result := result + '玖';
    end;
    if result = '×' then
    begin
      result := '';
      continue;
    end;
    case i of
      1: result := result + '十万';
      2: result := result + '万';
      3: result := result + '仟';
      4: result := result + '佰';
      5: result := result + '拾';
      6: result := result + '元';
    end;
  end;
//
  for i := 1 to 2 do
  begin
    tmpint := strtoint(copy(point, i, 1));
    case tmpint of
      0: begin
          if zeroflag = true then
            result := result + '×'
          else
            result := result + '零';
        end;
      1: result := result + '壹';
      2: result := result + '贰';
      3: result := result + '叁';
      4: result := result + '肆';
      5: result := result + '伍';
      6: result := result + '陆';
      7: result := result + '柒';
      8: result := result + '捌';
      9: result := result + '玖';
    end;
    case i of
      1: result := result + '角';
      2: result := result + '分';
    end;
  end;
end;

function GetFillZeroStr(AStr: string; Len: integer): string;
var
  S: string;
  i: integer;
begin
  result := '';
  if AStr = '' then exit;
  S := copy(AStr, 1, 1);
  if S = '0' then
  begin
    if length(Astr) < Len then
    begin
      for i := 1 to Len - length(Astr) do
        AStr := '0' + AStr;
    end;
    result := AStr;
  end
end;

procedure Ascii0ToSpace(p: pointer; Len: integer);
var
  pPChar: ^char; //指向结构体字符指针的变量
  TempC: char; //结构体字符指针的变量所指向的一个字符
  TempLen1: int64; //指针变量的十进制地址值
begin
  try
    pPChar := p;
    TempLen1 := int64(p); //把指针值转化为整形变量值
    TempC := pPChar^;
    while (int64(pPchar) - TempLen1) <= Len do
    begin
      if TempC = #0 then pPChar^ := ' ';
      inc(pPChar); //指针地址加1
      TempC := pPChar^;
    end;
  except
  end;
end;

procedure WriteLog(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