📄 publicfuncunit.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 + -