f_commfun.pas

用Delphi 开发的一个 户籍管理系统

unit f_commfun;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, ADODB, ComCtrls, ExtCtrls, Buttons, DBGrids, Registry,
  Clipbrd, cxGridDBTableView, winsock, WinTypes, WinProcs,
  f_netbios, f_md5, SUIDlg, SUIThemes, f_main, cxGridDBBANDEDTableView;

//定义用户信息
type
  userinfo = record
    uid: AnsiString; //工号
    Name: AnsiString; //姓名
    dept: AnsiString; //部门号
    deptname: AnsiString; //部门名
    role: integer; //角色编号
    power: AnsiString; //复杂系统的权限代码
    level: AnsiString; //简易系统的权限等级
    ip: AnsiString; //IP地址
    mac: AnsiString; //MAC地址
    ver: AnsiString; //版本号
    islogin:Boolean;
    ComputerName: AnsiString //用户计算机名
  end;
var
  user: userinfo;

function GetPreID(strsrc: AnsiString; flag: ansistring = '.'): AnsiString;
function GetAfterID(strsrc: AnsiString; flag: ansistring = '.'): AnsiString;
function GetBetweenID(strsrc: AnsiString; flagone: Ansistring; flagtwo:
  AnsiString): AnsiString;
function SaveSetup(section, Name, value: AnsiString): boolean;
function ReadSetup(section, Name: AnsiString): AnsiString;
function Question(str: AnsiString): boolean;
function IsInt(str: AnsiString): boolean;
function IsFloat(str: AnsiString): boolean;
function IsDate(str: AnsiString): boolean;
function replace_char(str, ch, re_str: AnsiString): AnsiString;
procedure CopyToClipboard(DBGrid_copy: TDBGrid; pb: TProgressBar = nil);
procedure CopyToClipboard2(tv: TcxGridDBTableView; pb: TProgressBar = nil);
procedure CopyToClipboard3(tv: TcxGridDBBandedTableView; pb: TProgressBar =
  nil);
procedure ShowOk(m: AnsiString);
procedure ShowError(m: AnsiString);
procedure SetNext(var Key: Char; h: hwnd);
function GetPYString(HzStr: string): string;
function GetPYIndexChar(hzchar: string): Char;
function MoneyToStr(Money: string): string;
function GetIp: string;
function GetMac(LanaNum: integer): string;
function password(pwd: AnsiString): string;
function GetGuid(): TGuid;
function GetMonth(num: integer): AnsiString;

implementation

function backDB(connection: tadoconnection; filename: string; dbname: string):
  boolean;
var
  adop: tadocommand;
begin
  result := false;
  adop := tadocommand.Create(nil);
  adop.Connection := connection;
  try
    adop.CommandText := 'backup database ' + trim(dbname) + ' To disk=' + '''' +
      trim(filename) + '''';
    adop.Execute;
    adop.Free;
    adop := nil;
    result := true;
  except
    adop.Free;
    adop := nil;
  end;
end;

function GetPreID(strsrc: AnsiString; flag: ansistring = '.'): AnsiString;
var
  tmp: AnsiString;
  ret: integer;
begin
  tmp := '';
  ret := AnsiPos(flag, strsrc);
  if ret <= 0 then
    GetPreID := tmp
  else
  begin
    tmp := Copy(strsrc, 1, ret - 1);
    GetPreID := tmp;
  end;
end;

function GetAfterID(strsrc: AnsiString; flag: ansistring = '.'): AnsiString;
var
  tmp: AnsiString;
  ret: integer;
begin
  tmp := '';
  ret := AnsiPos(flag, strsrc);
  if ret <= 0 then
    GetAfterID := tmp
  else
  begin
    tmp := Copy(strsrc, AnsiPos(flag, strsrc) + 1, Length(strsrc) -
      AnsiPos(flag, strsrc));
    GetAfterID := tmp;
  end;
end;

function GetBetweenID(strsrc: AnsiString; flagone: Ansistring; flagtwo:
  AnsiString): AnsiString;
var
  tmp: AnsiString;
  retone, rettwo: integer;
begin
  tmp := '';
  retone := AnsiPos(flagone, strsrc);
  rettwo := AnsiPos(flagtwo, strsrc);
  if retone <= 0 then
    GetBetweenID := tmp
  else if rettwo <= 0 then
    getbetweenid := tmp
  else
  begin
    tmp := Copy(strsrc, AnsiPos(flagone, strsrc) + 1, AnsiPos(flagtwo, strsrc) -
      AnsiPos(flagone, strsrc) - 1);
    GetbetweenID := tmp;
  end;
end;

function SaveSetup(section, Name, value: AnsiString): boolean;
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
    reg.OpenKey(section, true);
    reg.WriteString(Name, value);
    reg.CloseKey;
  except
    reg.Free;
    SaveSetup := false;
    exit;
  end;
  SaveSetup := true;
  reg.Free;
end;

function ReadSetup(section, Name: AnsiString): AnsiString;
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
    reg.OpenKey(section, true);
    ReadSetup := reg.ReadString(Name);
    reg.CloseKey;
  except
    reg.Free;
    ReadSetup := '';
    exit;
  end;
  reg.Free;
end;

function Question(str: AnsiString): boolean;
var
  mymd: Tsuimessagedialog;
begin
  mymd := Tsuimessagedialog.Create(fm_main);
  mymd.Text := str;
  mymd.IconType := suiinformation;
  mymd.UIStyle := winxp;
  mymd.Position := pomainformcenter;
  mymd.Caption := '请确认';
  mymd.ButtonCount := 2;
  mymd.Button1Caption := '确定';
  mymd.Button1ModalResult := mrok;
  mymd.Button2Caption := '取消';
  mymd.Button2ModalResult := mrcancel;
  if mymd.ShowModal = mrok then
    Question := true
  else
    Question := false;
  mymd.Destroy;
end;

function IsInt(str: AnsiString): boolean;
var
  v: integer;
begin
  IsInt := TryStrToInt(str, v);
end;

function IsFloat(str: AnsiString): boolean;
var
  v: double;
begin
  IsFloat := TryStrToFloat(str, v);
end;

function IsDate(str: AnsiString): boolean;
var
  v: TDateTime;
begin
  IsDate := TryStrToDate(str, v);
end;

function replace_char(str, ch, re_str: AnsiString): AnsiString;
var
  i: integer;
  tmp: AnsiString;
  Char: AnsiString;
begin
  tmp := '';
  for i := 0 to Length(str) - 1 do
  begin
    Char := PChar(str)[i];
    if Char = ch then
      tmp := tmp + re_str
    else
      tmp := tmp + Char;
  end;
  replace_char := tmp;
end;

procedure CopyToClipboard(DBGrid_copy: TDBGrid; pb: TProgressBar = nil);
var
  tmp: AnsiString;
  sp_i, i, k: integer;
  sql_copy: TDataSet;
  mymd: Tsuimessagedialog;
begin
  sql_copy := DBGrid_copy.DataSource.DataSet;
  if not sql_copy.Active or (sql_copy.RecordCount < 1) then
    exit;

  //读取列标题
  sp_i := DBGrid_copy.Columns.Count;
  for i := 0 to sp_i - 1 do
  begin
    if i = 0 then
      tmp := tmp + DBGrid_copy.Columns.Items[i].Title.Caption
    else
      tmp := tmp + chr(VK_TAB) + DBGrid_copy.Columns.Items[i].Title.Caption;
  end;
  tmp := tmp + chr(VK_RETURN);

  //定位到第一条记录
  sql_copy.DisableControls;
  sql_copy.First();

  //开始读取记录
  if pb <> nil then
  begin
    pb.Max := sql_copy.RecordCount;
    pb.Position := 0;
  end;
  for k := 0 to sql_copy.RecordCount - 1 do
  begin
    //读取各字段
    for i := 0 to sp_i - 1 do
    begin
      if i = 0 then
        tmp := tmp +
          Trim(sql_copy.FieldByName(DBGrid_copy.Columns.Items[i].FieldName).AsString)
      else
        tmp := tmp + chr(VK_TAB) +
          Trim(sql_copy.FieldByName(DBGrid_copy.Columns.Items[i].FieldName).AsString);
    end;
    tmp := tmp + chr(VK_RETURN);
    sql_copy.Next();
    if pb <> nil then
      pb.Position := pb.Position + 1;
  end;
  sql_copy.EnableControls;

  //拷贝到剪贴板
  Clipboard().SetTextBuf(PChar(tmp));

  mymd := Tsuimessagedialog.Create(fm_main);
  mymd.Text := '已经复制到剪贴板，你可以在Excel中粘贴此内容';
  mymd.IconType := suiinformation;
  mymd.UIStyle := winxp;
  mymd.Position := pomainformcenter;
  mymd.Caption := '提示';
  mymd.ButtonCount := 1;
  mymd.Button1Caption := '确定';
  mymd.ShowModal;
  mymd.Destroy;
  if pb <> nil then
    pb.Position := 0;
end;

procedure CopyToClipboard2(tv: TcxGridDBTableView; pb: TProgressBar = nil);
var
  tmp: AnsiString;
  sp_i, i, k: integer;
  sql_copy: TDataSet;
  mymd: Tsuimessagedialog;
begin
  sql_copy := tv.DataController.DataSource.DataSet;
  if not sql_copy.Active or (sql_copy.RecordCount < 1) then
    exit;

  //读取列标题
  sp_i := tv.ColumnCount;
  for i := 0 to sp_i - 1 do
  begin
    if i = 0 then
      tmp := tmp + tv.Columns[i].Caption
    else
      tmp := tmp + chr(VK_TAB) + tv.Columns[i].Caption;
  end;
  tmp := tmp + chr(VK_RETURN);

  //定位到第一条记录
  sql_copy.DisableControls;
  sql_copy.First();

  //开始读取记录
  if pb <> nil then
  begin
    pb.Max := sql_copy.RecordCount;
    pb.Position := 0;
  end;
  for k := 0 to sql_copy.RecordCount - 1 do
  begin
    //读取各字段
    for i := 0 to sp_i - 1 do
    begin
      if i = 0 then
        tmp := tmp +
          Trim(sql_copy.FieldByName(tv.Columns[i].DataBinding.FieldName).AsString)
      else
        tmp := tmp + chr(VK_TAB) +
          Trim(sql_copy.FieldByName(tv.Columns[i].DataBinding.FieldName).AsString);
    end;
    tmp := tmp + chr(VK_RETURN);