📄 myconlib.pas
字号:
unit myconLib;
interface
USES Windows, Messages, SysUtils, Classes,Controls,Graphics, Forms ;
Type TWhy=(FNone,FDialNoTone,FDialTimeOut,FDcdDrop,FGet30,FReadRtu,FReadClass);
Type TFailrec=Record
why:TWhy;
Phone:string[10];
end;
type TCMD=array[0..99] of byte;
type TdataRTU=record
A_Reg, B_Reg, C_Reg:Double;
A_Rev, B_Rev, C_Rev:Double;
QA_Reg, QB_Reg, QC_Reg:Double;
QA_Rev, QB_Rev, QC_Rev:Double;
end;
function ispe( a:byte):boolean;
Function crc16(buf:array of byte):Word;
Function UnkermitStr(src:string; var dst:string):boolean;
Function Unkermit(buf:array of byte;var getbuf:array of byte):word;
Function Kermitbuf( buf:array of byte;var getbuf:array of byte):integer;
Procedure Kermit( AByte:byte;var k23,kXor: byte);
Function RightStr(text: String; count: Integer): String;
Function QUstr(str: String): String;
Function getYM(adate:TdateTime):string;
Function getY(Y:word):string;
Function getM(m:word):string;
Function getD(adate:TdateTime):string;
procedure getYMD(var Y, M, D,y1,m1: string);
procedure getYMDEX(DX:TDateTime;var Y, M, D,y1,m1: string);
procedure getYMDInt(var Y, M, D,y1,m1: Word);
procedure getlastYM(Y, M:string;var y1,m1: string);
procedure getyears(cnt:integer;st:tstrings);
procedure GetLastY1M1(CurY_LastY:integer;var Y1,M1:string);
procedure delay(ms:DWORD);
procedure myBusy(YesNo:boolean);
Function IsPL(sw:string):boolean;
procedure Splitstr(aValue : String; aDelimiter : Char; Result : TStrings);
Function SplitToArray(aValue : String; var Rt : array of integer):integer;
Function DatacmdTocmd(data:Pointer;datasize:byte;Fun:byte; var cmd:TCMD):integer;
procedure clearRtuData(dataRtu: TdataRtu);
const FFFcmd:array[0..2] of byte =($FF,$FF,$FF);
const RTUClose6:array[0..5] of byte =($10,00,03,00,00,03);
const READADDR6: array[0..5] of byte =($10,00,04,00,00,04);
const READ20486: array[0..5] of byte =($10,00,09,00,00,09);
const PLcolor:Tcolor=clred;
const Otherdepcolor:Tcolor=clblue;
const revcolor:Tcolor=$FFEEDD;
const stopcolor:Tcolor=$F7EEFF;
var sysfile:string;
dbpath,inifile, tmpdb, inichao,
mapfile, treefile,treeEXfile:string;
PrintDBing:boolean;
viewmodechg:boolean;
BLineTILFile, StaicTILFile :string;
implementation
procedure Splitstr(aValue : String; aDelimiter : Char; Result : TStrings);
var
X : Integer;
S : String;
begin
if Result = nil then Result := TStringList.Create;
Result.Clear;
S := '';
for X:=1 to Length(aValue) do begin
if aValue[X] <> aDelimiter then
S:=S + aValue[X]
else begin
Result.Add(S);
S := '';
end;
end;
if S <> '' then Result.Add(S);
end;
Function DatacmdTocmd(data:Pointer;datasize:byte; Fun:byte;var cmd:TCMD):integer;
var i,axor,aadd:byte;
begin
if datasize=0 then begin result:=0; exit; end;
result:=5+datasize;
cmd[0]:=$10; //10
cmd[1]:=1+datasize; //Len;
cmd[2]:=fun; //fun
copymemory(@cmd[3],data,datasize);//data
axor:=0;aadd:=0;
for i:=1 to (2+datasize) do begin
axor:= axor xor cmd[i];
aadd:= aadd + cmd[i];
end;
cmd[3+datasize]:=axor;
cmd[4+datasize]:=aadd;
end;
Function SplitToArray(aValue : String; var Rt : array of integer):integer;
var
X ,k: Integer;
S : String;
begin
S := ''; k:=0;
for X:=1 to Length(aValue) do begin
if aValue[X] <> ',' then
S:=S + aValue[X]
else begin
try rt[k]:=strtoint(s);
except rt[k]:=0; end;
inc(k);
S := '';
end;
end;
if S <> '' then begin
try rt[k]:=strtoint(s);
except rt[k]:=0; end;
inc(k);
end;
result:=k;
end;
Function IsPL(sw:string):boolean;
var LN:integer;
begin
result:=false; LN:=length(sw);
if LN>2 then result:=sw[LN]='0' ;
end;
function ispe( a:byte):boolean;
begin
asm
mov al,a
and al,255
mov @result,1
jp @over
mov @result,0
@over:
nop
end;
end;
//****************************check****************************
Function crc16(buf:array of byte):Word;
var i,max,bit:integer;tmp:word;h1:boolean;
begin
max:=high(buf);
result:=0;
for i:=0 to max do begin
tmp:=buf[i]*$100;
result:=result xor tmp;
for bit:=0 to 7 do begin
h1:=(result and($8000))<>0;
result:=result shl 1;
if h1 then result:=result xor $1021
end;
end;
end;
{
Function UnkermitStr(src:string; var dst:string):boolean;
var i,Max:integer; lastis23:boolean ;
begin
max:=length(src); dst:=''; i:=1; lastis23:=false;
while i<=max do begin
if src[i]<=chr($20) then begin
result:=false;
exit;
end;
if src[i]=chr($23) then begin
if lastis23 then begin
dst:=dst+src[i] ;
lastis23 :=false;
inc(i);
end else begin
inc(i); lastis23:=true;
end;
end else begin
if lastis23 then begin
dst:=dst+ chr( ord(src[i]) xor $40 );
lastis23 :=false;
inc(i);
end else begin
dst:=dst+src[i] ;
lastis23:=false;
inc(i);
end;
end;
end;
if length(dst)=0 then result:=false else result:=true;
end;
}
{
Function UnkermitStr(src:string; var dst:string):boolean;
var i,Max:integer; lastis23:boolean ;
begin
max:=length(src); dst:=''; i:=1; lastis23:=false;
for i:=1 to Max do begin
if src[i]=chr($23) then begin
if lastis23 then begin
dst:=dst+src[i] ;
lastis23 :=false;
end else lastis23:=true;
end else begin
if lastis23 then dst:=dst+ chr( ord(src[i]) xor $40 )
else dst:=dst+src[i] ;
lastis23 :=false;
end;
end;
if length(dst)=0 then result:=false else result:=true;
end;
}
Function UnkermitStr(src:string; var dst:string):boolean;
var i,Max:integer; lastis23:boolean ;
begin
max:=length(src); dst:=''; i:=1; lastis23:=false;
for i:=1 to Max do begin
if src[i]=chr($23) then begin
if lastis23 then begin
dst:=dst+src[i] ;
lastis23 :=false;
end else lastis23:=true;
end else begin
if lastis23 then dst:=dst+ chr( ord(src[i]) xor $40 )
else dst:=dst+src[i] ;
lastis23 :=false;
end;
end;
if length(dst)=0 then result:=false else result:=true;
end;
Function Unkermit(buf:array of byte;var getbuf:array of byte):word;
var j,i:integer;
begin
i:=0; j:=0;
while i<=high(buf) do begin
if buf[i]=$23 then begin
inc(i);
if buf[i]=$23 then begin
getbuf[j]:=$23;
inc(i);inc(j);
end else begin
getbuf[j]:=buf[i] xor $40;
inc(i);inc(j);
end;
end else begin
getbuf[j]:=buf[i];
inc(i);inc(j);
end;
end;//while
dec(j);
result:=j;
end;
Procedure Kermit( AByte:byte;var k23,kXor: byte);
begin
case abyte of
$23:begin k23:=$23;kxor:=abyte; end;
$7F:begin k23:=$23;kxor:=abyte xor $40; end;
$0..$20:begin k23:=$23;kxor:=abyte xor $40; end;
else begin k23:=0;kxor:=abyte; end;
end;
end;
Function Kermitbuf( buf:array of byte;var getbuf:array of byte):integer;
var max,i,j:integer; k23,kxor:byte;
begin
max:=high(buf); j:=0;
for i:=0 to max do begin
kermit(buf[i],k23,kxor);
if k23<>0 then begin
getbuf[j]:=k23;inc(j);getbuf[j]:=kxor;inc(j);
end else begin getbuf[j]:=kxor;inc(j);end;
end;
result:=j;
end;
//*************************** **********************************
function RightStr(text: String; count: Integer): String;
begin
if count < Length(text) then
Result := Copy(text, Length(text) - count+1, count)
else
Result := text;
end;
Function QUstr(str: String): String;
begin
result:=''''+str+'''';
end;
Function getY(Y:word):string;
begin
result:=rightstr('00'+ inttostr(Y mod 100),2);
end;
Function getM(m:word):string;
begin
result:=rightstr('00'+inttostr(m),2);
end;
Function getYM(adate:TdateTime):string;
var Year, Month, Day: Word;
var y,m,d:string ;
begin
DecodeDate(adate, Year, Month, Day);
Y:= RightStr('0'+IntToStr(Year),2);
M:= RightStr('0'+IntToStr(Month),2);
D:= RightStr('0'+ IntToStr(Day),2);
result:=y+'年'+m;
end;
Function getD(adate:TdateTime):string;
var Year, Month, Day: Word;
begin
DecodeDate(adate, Year, Month, Day);
result:= RightStr('0'+ IntToStr(Day),2);
end;
procedure getYMDInt(var Y, M, D,y1,m1: Word);
begin
DecodeDate(Now, y, m, d);
if m=1 then begin
m1:=12 ;
y1:=y-1;
end
else begin
m1:=m-1 ;
y1:=y;
end;
end;
procedure getYMDEX(DX:TDateTime;var Y, M, D,y1,m1: string);
var Year, Month, Day: Word;
Year1, Month1:word;
begin
DecodeDate(DX, Year, Month, Day);
if month=1 then begin
month1:=12 ;
year1:=year-1;
end
else begin
month1:=month-1 ;
year1:=year;
end;
Y:= RightStr('0'+IntToStr(Year),2);
M:= RightStr('0'+IntToStr(Month),2);
D:= RightStr('0'+ IntToStr(Day),2);
Y1:= RightStr('0'+IntToStr(Year1),2);
M1:= RightStr('0'+IntToStr(Month1),2);
end;
procedure getYMD(var Y, M, D,y1,m1: string);
var Year, Month, Day: Word;
Year1, Month1:word;
begin
DecodeDate(Now, Year, Month, Day);
if month=1 then begin
month1:=12 ;
year1:=year-1;
end
else begin
month1:=month-1 ;
year1:=year;
end;
Y:= RightStr('0'+IntToStr(Year),2);
M:= RightStr('0'+IntToStr(Month),2);
D:= RightStr('0'+ IntToStr(Day),2);
Y1:= RightStr('0'+IntToStr(Year1),2);
M1:= RightStr('0'+IntToStr(Month1),2);
end;
procedure getyears(cnt:integer;st:tstrings);
var y, Year, Month, Day: Word;
ys:string;
var i:integer;
begin
DecodeDate(date, Year, Month, Day);
st.clear;
for i:=0 to cnt do begin
y:=(Year+100-i) mod 100 ;
if y<=9 then Ys:= '0'+IntToStr(y)
else Ys:= IntToStr(y);
st.add(ys);
end;
end;
procedure GetLastY1M1(CurY_LastY:integer;var Y1,M1:string);
var Dx:TdateTime;
var Year, Month, Day: Word;
begin
Dx:=Date ;
Dx:=IncMonth(Dx,(-1)*CurY_LastY);
DecodeDate(Dx, Year, Month, Day);
Y1:= RightStr('00'+IntToStr(Year),2);
M1:= RightStr('00'+IntToStr(Month),2);
end;
procedure delay(ms:DWORD);
var t:DWORD;
begin
t:=gettickcount;
while gettickcount <t+ms do
application.ProcessMessages;
end;
procedure myBusy(YesNo:boolean);
begin
if Yesno then screen.Cursor:=crHourGlass
else screen.Cursor:=crDefault;
end;
procedure getlastYM(Y, M:string;var y1,m1: string);
var Year, Month: Word;
Year1,Month1:word;
begin
year:=strtoint(y); month:=strtoint(m);
if month=1 then begin
month1:=12 ;
year1:=year-1;
end
else begin
month1:=month-1 ;
year1:=year;
end;
Y1:= RightStr('0'+IntToStr(Year1),2);
M1:= RightStr('0'+IntToStr(Month1),2);
end;
procedure clearRtuData(dataRtu: TdataRtu);
begin
datartu.A_Reg:=0.0; datartu.B_Reg:=0.0; datartu.C_Reg:=0.0;
datartu.A_ReV:=0.0; datartu.B_ReV:=0.0; datartu.C_ReV:=0.0;
datartu.QA_Reg:=0.0; datartu.QB_Reg:=0.0; datartu.QC_Reg:=0.0;
datartu.QA_ReV:=0.0; datartu.QB_ReV:=0.0; datartu.QC_ReV:=0.0;
end;
initialization
dbpath:=extractfilepath(application.ExeName)+'db\';
tmpdb:=extractfilepath(application.ExeName)+'tmpdb\';
sysfile:=extractfilepath(application.ExeName)+'system\';
mapfile:=sysfile+'maphint.dat';
treefile:=sysfile+'tree.dat' ;
treeEXfile:=sysfile+'treeEX.dat' ;
inifile:=sysfile+'dbini.ini';
inichao:=sysfile+'chao.ini';
BLineTILFile:=sysfile+'Bline.txt';
StaicTILFile:=sysfile+'TIL.txt';
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -