⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 publicfuncunit.pas

📁 随便说说最近项目中的三层架构吧。讲点实际的东西。我最讨厌空讲道理。网上讲道理的太多了
💻 PAS
字号:
/////////////////////////////////////////////////////////////////////////////
// 1.全局公共函数区
//
//
/////////////////////////////////////////////////////////////////////////////



unit PublicFuncUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, DBGrids, DBCtrls, Mask, ExtCtrls, ComCtrls, DBClient,
  Contnrs, QButtons, DataStructureUnit;

type TAllowSetContrl = class of TControl;

const
  s_Key = '#@D1&82X%)#@@#@$iiLE~!jkllk$#%';
  i_arymax = 12;
  ary_Focus: array[1..i_arymax] of TAllowSetContrl=(TEdit, TCheckBox, TRadioButton,
      TComboBox, TMaskEdit, TLabeledEdit, TDateTimePicker, TComboBoxEx, TDBEdit,
      TDBComboBox,TDBCheckBox, TDBLookupComboBox );

  titlestr:array[0..15] of byte=
       ($00,$01,$00,$00,$53,$74,$61,$6E,$64,$61,$72,$64,$20,$4A,$65,$74);
  titlestr2:array[0..15] of byte=
       ($42,$6A,$46,$58,$58,$43,$44,$59,$4B,$4A,$47,$46,$59,$58,$47,$53);

  
  function EncodeStr(s_str,s_key: String):String;           //加密函数
  function DecodeStr(s_str,s_key: String):String;           //解密函数
  procedure EncryptDB(sFileName: String; connKind: TConnDBKind);   //加密ACCESS数据库
  procedure UnEncryptDB(sFileName: String; connKind: TConnDBKind); //解密ACCESS数据库

  procedure SetFormAutoSize(oForm:TForm);                 //窗体自动缩放:
  procedure SetFormKeyDown(oForm:TForm; Sender: TObject; var Key: Word;
                           Shift: TShiftState);           //上下箭头键代替回车:
  function  IsAllowSetFocus(oForm:TForm):Boolean;         //控件是否允许通过回车键得到焦点:
  procedure SetFormKeyPress(oForm:TForm; var Key: Char);  //截获键消息:

  //客户端数据持久层函数调用方法:
  {
  function SelectDataSet(const PWStr: pWideString; IDataPer: IDataPersistent;
                      var PAPrvName: pAnsiString): Boolean; Stdcall; external 'DLLDataPersistent.dll';
  function InsertDataSet(const PWStr: pWideString; IDataPer: IDataPersistent): Integer; Stdcall;
                         external 'DLLDataPersistent.dll';
  function UpdateDataSet(const PWStr: pWideString; IDataPer: IDataPersistent): Integer; Stdcall;
                         external 'DLLDataPersistent.dll';
  function DeleteDataSet(const PWStr: pWideString; IDataPer: IDataPersistent): Integer; Stdcall;
                         external 'DLLDataPersistent.dll';
  procedure CloseDataSet(const PWStr: pWideString; IDataPer: IDataPersistent); Stdcall;
                         external 'DLLDataPersistent.dll';  }

  //封装之后的持久层方法调用:
  {
  procedure CloseClientDS(var DataSet: TClientDataSet; IDataPer: IDataPersistent);
  Procedure CloseRDMDS(var DataSet: TClientDataSet; IDataPer: IDataPersistent);

  function  SelectRDMDS(const SqlStr: WideString; IDataPer: IDataPersistent;
                        var DataSet: TClientDataSet): Boolean;
  function InsertRDMDS(const SqlStr: WideString; IDataPer: IDataPersistent): Integer;
  function UpdateRDMDS(const SqlStr: WideString; IDataPer: IDataPersistent): Integer;
  function DeleteRDMDS(const SqlStr: WideString; IDataPer: IDataPersistent): Integer;
  }

implementation


function EncodeStr(s_str,s_key: String):String;
var l1,l2,p1,p2:integer; ch:byte;
begin
  l1:=Length(s_str); p1:=1;
  l2:=Length(s_key);    p2:=1;
  Result:='';
  while p1<=l1 do
  begin
    ch:=(byte(s_str[p1])-1) xor byte(s_key[p2]);
    if ch=0 then ch:=not byte(s_key[p2]);
    Result:=Result+CHAR(ch);
    inc(p1); if p2=l2 then p2:=1 else inc(p2);
  end;
end;


function DecodeStr(s_str,s_key: String):String;
var l1,l2,p1,p2:integer; ch:byte;
begin
  l1:=Length(s_str); p1:=1;
  l2:=Length(s_key);    p2:=1;
  Result:='';
  while p1<=l1 do
  begin
    ch:=byte(s_str[p1]);
    if ch=(not byte(s_key[p2])) then ch:=byte(s_key[p2])
    else ch:=ch xor byte(s_key[p2]);
    Result:=Result+CHAR(ch+1);
    inc(p1); if p2=l2 then p2:=1 else inc(p2);
  end;
end;


procedure EncryptDB(sFileName: String; connKind: TConnDBKind);
var
  F: TFileStream;
  hMutex:HWND;
begin
  hMutex := CreateMutex(nil, False, 'EntryCardAccess');
  if GetLastError = ERROR_ALREADY_EXISTS then
  begin
    if connKind <> dbACCESS then Exit;
    if (length(sFileName)=0) or (not fileExists(sFileName)) then exit;

    F:=TFileStream.create(sFileName,fmopenwrite);
    try
      F.seek($00,soFromBeginning);
      F.Write(titlestr2,16);
    finally
      F.free;
    end;
  end;

end;

procedure UnEncryptDB(sFileName: String; connKind: TConnDBKind);
var
  F: TFileStream;
  hMutex:HWND;
begin
  hMutex := CreateMutex(nil, False, 'EntryCardAccess');
  if GetLastError = ERROR_ALREADY_EXISTS then exit;

  if (length(sFileName)=0) or (not fileExists(sFileName)) then exit;
  F := TFileStream.create(sFileName,fmopenwrite);
  try
    F.seek($00,soFromBeginning);
    F.Write(titlestr,16);
  finally
  F.free;
  end;
end;


procedure SetFormAutoSize(oForm:TForm);
var i_nw, i_nh, i_i, i_j, i_nchgsize: integer;
    r_wbl, r_hbl: real;
begin
  with oForm do
  begin
    i_nw := screen.Width;
    i_nh := screen.Height;
    r_wbl := i_nw/800;
    r_hbl := i_nh/600;
    width := trunc(Width*r_wbl);
    Height := trunc(Height*r_wbl);

    if i_nw = 800 then
      Exit;

    case i_nw  of
      800  : i_nchgsize := 0;
      640  : i_nchgsize := -1;
      1024 : i_nchgsize := 1;
    end;

    if i_nw >1024 then
      i_nchgsize := 2;

    for i_i:=0 to ComponentCount -1 do
    begin
      if ( (Components[i_i] is TControl) and  (not (Components[i_i] is TToolButton)) ) then
        with TControl(Components[i_i]) do
        begin
          Width := trunc(Width* r_wbl);
          Height := trunc(Height* r_hbl);
          top := trunc(top* r_hbl);
          left := trunc(left* r_wbl);
        end;

        if (Components[i_i] is TLabel)
             or (Components[i_i] is TPanel)
             or (Components[i_i] is TEdit)
             or (Components[i_i] is TDBEdit)
             or (Components[i_i] is TCustomGrid)
             or (Components[i_i] is TBitBtn)
             or (Components[i_i] is TButton)
             or (Components[i_i] is TSpeedButton) then

          with TLabel(Components[i_i]) do
          begin
            if not ((i_nchgsize <0) and (Font.Size <=10) and
               not (fsBold in Font.Style))  then
              Font.Size := Font.Size + i_nchgsize;
          end;

          if ( (Components[i_i] is TCustomGrid) or (Components[i_i] is TDBGrid) ) then
            with TDBGrid(Components[i_i]) do
            begin
                for i_j:=0 to  Columns.Count -1 do
                begin
                   Columns[i_j].Width := trunc(Columns[i_j].Width * r_wbl);
                   Columns[i_j].Font.Size := Columns[i_j].Font.Size+ i_nchgsize;
                   Columns[i_j].Title.Font.Size := Columns[i_j].Title.Font.Size+ i_nchgsize;
                end;
             end;
     end;

     oForm.SetBounds((Screen.Width -Width) div 2,
                 (Screen.Height - Height) div 2,
                 Width, Height);
     Font.Size := Font.Size + i_nchgsize;
   end;
end;


procedure SetFormKeyDown(oForm:TForm; Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  i_i :Integer;
begin
  with oForm do
  begin
    Case Key of
      VK_DOWN:
        if true then SendMessage(oForm.Handle,WM_NEXTDLGCTL,0,0);
      VK_UP:
        begin
          for i_i:=0 to ComponentCount-1 do
          begin
            if (Components[i_i] is TControl) then
            begin
              if (Components[i_i] as TWinControl).TabOrder = ActiveControl.TabOrder-1 then
              begin
                (Components[i_i] as TWinControl).SetFocus;
                break;
              end;    {
              if TWinControl(Components[i_i]).TabOrder = ActiveControl.TabOrder-1 then
                TWinControl(Components[i_i]).SetFocus;
              break;  }
            end;
          end;
        end;
    end;
    
  end;
end;


function IsAllowSetFocus(oForm:TForm):Boolean;
var
  i_i : Integer;
begin
  for i_i:=1 to i_arymax do
  begin
    if oForm.ActiveControl is ary_Focus[i_i] then
    begin
      Result := true;
      break;
    end else
          Result := false;
  end;
end;


procedure  SetFormKeyPress(oForm:TForm; var Key: Char);
begin
  if Key = #13 then
  begin
    if IsAllowSetFocus(oForm) then
    begin
      Key :=#0;
      SendMessage(oForm.Handle,WM_NEXTDLGCTL,0,0);
    end;
  end;
end;

{
procedure CloseClientDS(var DataSet: TClientDataSet; IDataPer: IDataPersistent);
begin
  CloseRDMDS(DataSet, IDataPer);
  DataSet.Close;
end;

Procedure CloseRDMDS(var DataSet: TClientDataSet; IDataPer: IDataPersistent);
var
  lsProviderName: WideString;
begin
  lsProviderName:=DataSet.ProviderName;
  CloseDataSet(@lsProviderName, IDataPer);
end;

function InsertRDMDS(const SqlStr: WideString; IDataPer: IDataPersistent): Integer;
begin
  result := InsertDataSet(@SqlStr, IDataPer);
  if result = -1 then
  begin

    DmRtu.DCOMRTU.Close;
    DmRtu.DCOMRTU.Open;
    result := InsertDataSet(@SqlStr, IDataPer);
  end;
end;

function UpdateRDMDS(const SqlStr: WideString;  IDataPer: IDataPersistent): Integer;
begin
  result := UpdateDataSet(@SqlStr, IDataPer);
  if result = -1 then
  begin

    DmRtu.DCOMRTU.Close;
    DmRtu.DCOMRTU.Open;
    result := UpdateDataSet(@SqlStr, IDataPer);
  end;
end;

function DeleteRDMDS(const SqlStr: WideString;  IDataPer: IDataPersistent): Integer;
begin
  result := DeleteDataSet(@SqlStr, IDataPer);
  if result = -1 then
  begin

    DmRtu.DCOMRTU.Close;
    DmRtu.DCOMRTU.Open;
    result := DeleteDataSet(@SqlStr, IDataPer);
  end;
end;


function  SelectRDMDS(const SqlStr: WideString; IDataPer: IDataPersistent;
                        var DataSet: TClientDataSet): Boolean;
var
  lsProviderName: WideString;
  plsProviderName: pAnsiString;
begin
  plsProviderName:=nil;
  Result:=False;
  if SelectDataSet(@SqlStr, IDataPer, plsProviderName) then
  begin
    lsProviderName := plsProviderName^;
    DataSet.ProviderName := lsProviderName;
    Try
      DataSet.Close;
      DataSet.Open;
      Result:=True;
    except
      Result:=false;
    end;
  end else
    begin

      DmRtu.DCOMRTU.Close;
      DmRtu.DCOMRTU.Open;
      
      if SelectDataSet(@SqlStr, IDataPer, plsProviderName) then
      begin
        lsProviderName:=plsProviderName^;
        DataSet.ProviderName:=lsProviderName;
        Try
          DataSet.Close;
          DataSet.Open;
          Result:=True;
        except
          Result:=false;
        end;
      end;
    end;
end;  }


end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -