RTFormwork/项目代码/RTBasicsV1/C02纱线加弹检验/DbPanel/dsr.pas
“ddf” 61630656e9 1
2024-07-07 09:35:27 +08:00

331 lines
8.7 KiB
ObjectPascal
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

unit dsr;
interface
uses
SysUtils, StrUtils, Forms, Classes, DB, ADODB, Grids, DBGrids, Messages;
var
CanLCCL :Boolean;
V_User,V_UserID :string;
TmpHandle :THandle;
cnn_Base :TAdoConnection;
function SplitString(STR_Source :string; STR_Split:string):TStringList;
procedure DoAbnormalC(H: THandle;AConn: TADOConnection;UID: String;
UName: String;TRCarNo: String);stdcall;external 'frabnml.dll';
{
procedure DoRinseprt(H: THandle;//调用窗口句柄
AConn: TADOConnection;//ADO连接
UID: String;//操作员号
UName: String;//操作员名
Machine: String;//机台编号
Task: String//任务序次
);stdcall;
}
procedure DoRinseprt(H: THandle;AConn: TADOConnection;UID:String;
UName :String; Machine:String; Task:String); stdcall; external 'rinsepf.dll';
procedure Set_NextControl( Pass_Form: TCustomForm;var Key:Char);
function checkfunc(handle: Integer; DogFlag: String): Integer; stdcall; external 'FUTONG.DLL';
//检查硬件狗函数
// handle为主窗口句柄
// DogFlag为从数据库中查询到的硬件狗信息
// DLL自动检查硬件狗和DogFlag的信息是否相符不符时将在3分钟左右自动重启计算机
function GetParm(flag: Integer; out len: Integer; outHex: PAnsiChar): Integer; stdcall; external 'FUTONG.DLL';
//硬件狗中获取特定信息如IP地址数据库名称用户名、口令等
//自定义参数flag取值范围为0--4存储空间一共为20个字节为连续的地址空间
//也即参数0最大可用长度为20这时其他参数将覆盖这个区域
// 参数4最大可用长度为4
//DogFlag为字符串信息
function SetParm(flag, len: Integer; inHex: PAnsiChar): Integer; stdcall; external 'FUTONG.DLL';
//flag=5IP,=6User,=7Pass,=8DB
//硬件狗中设置参数传入IP时须设置为 “C8A00164”等形式传入192.168.1.100
//自定义参数用法同上
function InfoFunc(order: Integer; info: PAnsiChar): Integer; stdcall; external 'FUTONG.DLL';
//读取本机硬件信息,返回值为机器网卡个数
//考虑到某些可移动的网卡,要查询固定的网卡信息
//软件安装时要求移除可移动网卡
//order为第几块网卡从0开始
function GetHostIpAddr(DogParm, HostName, IPAddr: PAnsiChar): Integer; stdcall; external 'FUTONG.DLL';
//获取硬件狗标识,本机IP地址仅参考因为机器有多个IP地址获取的只是其中之一
//以及机器名称
function PBEncode(Inbuf: PAnsiChar; out Outbuf: AnsiString; nInLen: Word; nOutLen: Word): Integer;
function PBEncode1(Inbuf: PAnsiChar; out Outbuf: AnsiString; nInLen: Word; nOutLen: Word): Integer;
function PBDecode(Inbuf: PAnsiChar; out Outbuf: AnsiString; nInLen: Word; nOutLen: Word): Integer;
implementation
function SplitString(STR_Source :string; STR_Split:string):TStringList;
var
temp:String;
i:Integer;
begin
Result:=TStringList.Create;
//如果是空自符串则返回空列表
if trim(STR_Source) = '' then exit;
temp:=STR_Source;
i:=pos(STR_Split,STR_Source);
while i <> 0 do
begin
Result.add(copy(temp,0,i-1));
Delete(temp,1,i+length(STR_Split)-1); //如果STR_Split长度大于1的话,原来的只删除STR_Split字符的第一个.
i:=pos(STR_Split,temp);
end;
Result.add(temp);
end;
procedure Set_NextControl( Pass_Form: TCustomForm;var Key:Char);
label
labe_A;
begin
if key=#13 then
if not (Pass_Form.ActiveControl is TDbgrid) Then
Begin
key:=#0;
Pass_Form.perform(WM_NEXTDLGCTL,0,0);
end
else
if (Pass_Form.ActiveControl is TDbgrid) Then
begin
With TDbgrid(Pass_Form.ActiveControl) Do
begin
labe_A:
if Selectedindex<(FieldCount-1) then
Selectedindex:=Selectedindex+1
else Selectedindex:=0;
if not Columns[Selectedindex].Visible then
goto labe_A;
end;
end;
end;
function PBEncode(Inbuf: PAnsiChar; out Outbuf: AnsiString; nInLen: Word; nOutLen: Word): Integer;
var
table: array[0..63] of AnsiChar;
c80, c81, c82, c6: AnsiChar;
i, k, len: Integer;
Tmpbuf: array[0..255] of AnsiChar;
begin
table := 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
if (nInLen*4)>(nOutLen*3+3) then Result := 1;
k := nInLen div 3;
len := k*4;
for i:=0 to k-1 do
begin
c80 := Inbuf[i*3];
c6 := Char(Integer(c80) shr 2);
Tmpbuf[i*4] := table[Integer(c6) and $3f];
c80 := Char((Integer(c80) shl 4) and $30);
c81 := Inbuf[i*3+1];
c6 := Char((Integer(c81) shr 4) and $0f);
Tmpbuf[i*4+1] := table[Integer(c80) or Integer(c6)];
c81 := Char((Integer(c81) shl 2) and $3c);
c82 := Inbuf[i*3+2];
c6 := Char((Integer(c82) shr 6) and $03);
Tmpbuf[i*4+2] := table[Integer(c81) or Integer(c6)];
Tmpbuf[i*4+3] := table[Integer(c82) and $3f];
end;
i := nInLen mod 3;
k := nInLen div 3;
if i<>0 then
begin
len := len+4;
c80 := Inbuf[k*3];
c6 := Char(Integer(c80) shr 2);
Tmpbuf[k*4] := table[Integer(c6) and $3f];
if k=1 then
begin
c80 := Char((Integer(c80) shl 4) and $30);
Tmpbuf[k*4+1] := table[Integer(c80)];
Tmpbuf[k*4+2] := '=';
end
else
begin
c80 := Char((Integer(c80) shl 4) and $30);
c81 := Inbuf[k*3+1];
c6 := Char((Integer(c81) shr 4) and $0f);
Tmpbuf[k*4+1] := table[Integer(c80) or Integer(c6)];
c81 := Char((Integer(c81) shl 2) and $3c);
Tmpbuf[k*4+2] := table[Integer(c81)];
end;
Tmpbuf[k*4+3] := '=';
end;
Tmpbuf[len] := #0;
Outbuf := Tmpbuf;
Result := len;
end;
function PBEncode1(Inbuf: PAnsiChar; out Outbuf: AnsiString; nInLen: Word; nOutLen: Word): Integer;
var
table: array[0..63] of AnsiChar;
c80, c81, c82, c6: AnsiChar;
i, k, len: Integer;
Tmpbuf: array[0..255] of AnsiChar;
begin
table := 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
if (nInLen*4)>(nOutLen*3+3) then Result := 1;
k := nInLen div 3;
len := k*4;
for i:=0 to k-1 do
begin
c80 := Inbuf[i*3];
c6 := Char(Integer(c80) shr 2);
Tmpbuf[i*4] := table[Integer(c6) and $3f];
c80 := Char((Integer(c80) shl 4) and $30);
c81 := Inbuf[i*3+1];
c6 := Char((Integer(c81) shr 4) and $0f);
Tmpbuf[i*4+1] := table[Integer(c80) or Integer(c6)];
c81 := Char((Integer(c81) shl 2) and $3c);
c82 := Inbuf[i*3+2];
c6 := Char((Integer(c82) shr 6) and $03);
Tmpbuf[i*4+2] := table[Integer(c81) or Integer(c6)];
Tmpbuf[i*4+3] := table[Integer(c82) and $3f];
end;
i := nInLen mod 3;
k := nInLen div 3;
if i<>0 then
begin
len := len+4;
c80 := Inbuf[k*3];
c6 := Char(Integer(c80) shr 2);
Tmpbuf[k*4] := table[Integer(c6) and $3f];
if i=1 then
begin
c80 := Char((Integer(c80) shl 4) and $30);
Tmpbuf[k*4+1] := table[Integer(c80)];
Tmpbuf[k*4+2] := '=';
end
else
begin
c80 := Char((Integer(c80) shl 4) and $30);
c81 := Inbuf[k*3+1];
c6 := Char((Integer(c81) shr 4) and $0f);
Tmpbuf[k*4+1] := table[Integer(c80) or Integer(c6)];
c81 := Char((Integer(c81) shl 2) and $3c);
Tmpbuf[k*4+2] := table[Integer(c81)];
end;
Tmpbuf[k*4+3] := '=';
end;
Tmpbuf[len] := #0;
Outbuf := Tmpbuf;
Result := len;
end;
function PBDecode(Inbuf: PAnsiChar; out Outbuf: AnsiString; nInLen: Word; nOutLen: Word): Integer;
var
pBufIn: PAnsiChar;
szBufTmp: array[0..255] of AnsiChar;
i, dwCoded, nprbytes, nbytesdecoded: Integer;
pszCoded: PAnsiChar;
szBufout: array[0..255] of AnsiChar;
pszBufout: PAnsiChar;
pr2six: array[0..255] of Word;
begin
for i := 0 to 42 do
pr2six[i] := 64;
pr2six[43] := 62;
for i := 44 to 46 do
pr2six[i] := 64;
pr2six[47] := 63;
for i := 48 to 57 do
pr2six[i] := i+4;
for i := 58 to 64 do
pr2six[i] := 64;
for i := 65 to 90 do
pr2six[i] := i-65;
for i := 91 to 96 do
pr2six[i] := 64;
for i := 97 to 122 do
pr2six[i] := i-71;
for i := 123 to 255 do
pr2six[i] := 64;
dwCoded := nInlen;
pszCoded := Inbuf;
while (dwCoded>0) and (pszCoded=' ') do
begin
Inc(pszCoded);
Dec(dwCoded);
end;
if dwCoded>(350-4) then result := 1;
StrLCopy(szBufTmp, pszCoded, dwCoded);
szBufTmp[dwCoded] := #0;
szBufTmp[dwCoded+1] := #0;
szBufTmp[dwCoded+2] := #0;
szBufTmp[dwCoded+3] := #0;
pBufIn := szBufTmp;
repeat
i := pr2six[Integer(pBufIn^)];
Inc(pBufIn);
until i>63;
nprbytes := pBufin-szBufTmp-1;
nbytesdecoded := ((nprbytes+3) div 4)*3;
if nOutLen<nbytesdecoded then result := 2;
if nbytesdecoded>(256-4) then result := 2;
pszBufout := szBufout;
pBufin := szBufTmp;
while nprbytes>0 do
begin
pszBufout^ := Char((pr2six[Integer(pBufin[0])] shl 2) or ((pr2six[Integer(pBufin[1])] shr 4)));
Inc(pszBufout);
pszBufout^ := Char((pr2six[Integer(pBufin[1])] shl 4) or ((pr2six[Integer(pBufin[2])] shr 2)));
Inc(pszBufout);
pszBufout^ := Char((pr2six[Integer(pBufin[2])] shl 6) or (pr2six[Integer(pBufin[3])]));
Inc(pszBufout);
Inc(pBufin, 4);
Dec(nprbytes, 4);
end;
if (nprbytes and $03) <> 0 then
begin
if pr2six[Integer(pBufin[-2])]>63 then Dec(nbytesdecoded, 2)
else Dec(nbytesdecoded);
end;
szBufout[nbytesdecoded] := #0;
Outbuf := szBufout;
result := nbytesdecoded;
end;
end.