一个串口通讯的例子（ABX PENTRA 120）
先看通讯数据解析后的内容
这是 ABX PENTRA 120 血球仪的通讯数据，这个数据是通过RS232和设备通讯得到的。通讯协议？ 木有，这是法国的一个设备，通讯协议不公开。其实很多设备的通讯都是靠逆向，做LIS，俺至少逆向了 20种设备的协议。下面一个通讯的数据的例子：
这个通讯数据的部分的数据都一眼能看出来。唯一麻烦的就是下面这个图的解析。
这个图的数据来自
但是 颜色的处理却来自上面的一个数组。
if pos(strCanal, strPCanalList) > 0 then
begin
strV := lines[i + 5];
strV := copy(strV, 2, length(strV) - 1);
for m := 1 to 15 do
begin
XorY[m] := strtoint(copy(strV, 4 * (m - 1) + 1, 4));
end;
for m := 1 to 6 do
begin
ArrRgn1[m].X := XorY[rgnP1[m, 1]];
ArrRgn1[m].y := 128 - XorY[rgnP1[m, 2]];
end;
DeleteObject(myRGN1);
myRGN1 := CreatePolygonRgn(ArrRgn1, 6, ALTERNATE);
for m := 1 to 6 do
begin
ArrRgn2[m].X := XorY[rgnP2[m, 1]];
ArrRgn2[m].y := 128 - XorY[rgnP2[m, 2]];
end;
DeleteObject(myRGN2);
myRGN2 := CreatePolygonRgn(ArrRgn2, 6, ALTERNATE);
for m := 1 to 4 do
begin
ArrRgn3[m].X := XorY[rgnP3[m, 1]];
ArrRgn3[m].y := 128 - XorY[rgnP3[m, 2]];
end;
DeleteObject(myRGN3);
myRGN3 := CreatePolygonRgn(ArrRgn3, 4, ALTERNATE);
setlength(binbuf, 1);
strV := copy(line, 3, 4096);
mybmp := TBitmap.Create;
mybmp.HandleType := bmDIB;
mybmp.Width := 128;
mybmp.Height := 128;
mybmp.Canvas.pen.Color := 0;
mybmp.Canvas.Brush.Color := clwhite;
mybmp.Transparent := true;
for j := 0 to 127 do //行
for k := 0 to 15 do //列
begin
str := copy(strV, 32 * j + 2 * k + 1, 2);
hextobin(pchar(str), pchar(binbuf), 2);
c := byte(binbuf[1]);
for m := 0 to 7 do
begin
b := byte(#128);
b := b shr m;
b := b and c;
if integer(b) <> 0 then
begin
if PtInRegion(myRGN1, k * 8 + m, j) then
mybmp.Canvas.Pixels[k * 8 + m, j] := clred
else
if PtInRegion(myRGN2, k * 8 + m, j) then
mybmp.Canvas.Pixels[k * 8 + m, j] := clgreen
else
if PtInRegion(myRGN3, k * 8 + m, j) then
mybmp.Canvas.Pixels[k * 8 + m, j] := clblue
else
mybmp.Canvas.Pixels[k * 8 + m, j] := 0;
end;
end;
end;
mybmp.Canvas.TextOut(4, 4, 'LMNE');
mybmp.Canvas.MoveTo(0, 0);
mybmp.Canvas.lineTo(0, 127);
mybmp.Canvas.lineTo(127, 127);
mybmp.Canvas.lineTo(127, 0);
mybmp.Canvas.lineTo(0, 0);
for m := 1 to 10 do
begin
mybmp.Canvas.MoveTo(XorY[LineSeting1[m, 1]], 128 - XorY[LineSeting1[m, 2]]);
mybmp.Canvas.LineTo(XorY[LineSeting1[m, 3]], 128 - XorY[LineSeting1[m, 4]]);
end;
mybmp.Canvas.pen.Style := psDot;
for m := 1 to 3 do
begin
mybmp.Canvas.MoveTo(XorY[LineSeting2[m, 1]], 128 - XorY[LineSeting2[m, 2]]);
mybmp.Canvas.LineTo(XorY[LineSeting2[m, 3]], 128 - XorY[LineSeting2[m, 4]]);
end;
{ mybmp.Canvas.Brush.Color := clred;
FrameRgn(mybmp.Canvas.Handle, myRGN1, mybmp.Canvas.Brush.Handle, 1, 1);
mybmp.Canvas.Brush.Color := clgreen;
FrameRgn(mybmp.Canvas.Handle, myRGN2, mybmp.Canvas.Brush.Handle, 1, 1);
mybmp.Canvas.Brush.Color := clBlue;
FrameRgn(mybmp.Canvas.Handle, myRGN3, mybmp.Canvas.Brush.Handle, 1, 1);
}
strV := '';
MemStr := TMemoryStream.Create;
mybmp.PixelFormat := pf4bit;
mybmp.SaveToStream(MemStr);
mybmp.Free;
m := MemStr.Size;
setlength(strV, m);
MemStr.Seek(0, soBeginning);
MemStr.ReadBuffer(Pointer(strV)^, m);
Bk.AddItem('LMNE', '', 'P', strV);
MemStr.Free;
DeleteObject(myRGN1);
DeleteObject(myRGN2);
end;
end;
全部代码
library PENTRA120;
uses
Windows,
SysUtils,
Classes,
Graphics,
BlockModule in 'BlockModule.pas';
{
Interval=-1 立即发
Interval=0 不发
interval>0 重发
}
var
in_debug: boolean = false;
BlockData: string;
XorY: array[0..16] of integer =
(
0,
22,
025,
048,
035,
118,
030,
068,
078,
090,
070,
090,
118,
029,
074,
051,
128
);
LineSeting1: array[1..10, 1..4] of integer =
((1, 0, 1, 13), (2, 13, 2, 14), (3, 14, 3, 16), (12, 0, 12, 15), (5, 15, 5, 14), (8, 13, 9, 0), (10, 13, 11, 15), (2, 14, 16, 14), (11, 15, 12, 15), (1, 13, 8, 13));
LineSeting2: array[1..3, 1..4] of integer =
((6, 0, 6, 13), (7, 0, 7, 13), (4, 13, 4, 14));
rgnP1: array[1..6, 1..2] of integer =
((2, 13), (2, 14), (5, 14), (5, 15), (11, 15), (10, 13));
rgnP2: array[1..6, 1..2] of integer =
((8, 13), (10, 13), (9, 15), (12, 15), (12, 0), (11, 0));
rgnP3: array[1..4, 1..2] of integer =
((1, 0), (1, 13), (8, 13), (9, 0));
procedure WriteToFile(Buffer: Pointer; BufferLength: Word; DevName: string; OutFileName: string; var Interval: integer; var SendBuf: PChar);
const
strACanalList = '!"#$%()*+,-./012345678@ABC';
codeList: array[1..26] of string =
('WBC', 'LYM', 'LYM%', 'MON', 'MON%', 'NEU', 'NEU%', 'EOS', 'EOS%', 'BAS', 'BAS%', 'ALY', 'ALY%', 'LIC', 'LIC%'
, 'RBC', 'HGB', 'HCT', 'MCV', 'MCH', 'MCHC', 'RDW', 'PLT', 'MPV', 'PCT', 'PDW');
strGCanalList = 'XYZ';
strPCanalList = '[';
var
Bk: TBlock;
Bks: TBlocks;
str, strV, binbuf, strCode, strLineFlag: string;
i, j, m, k, itemIDX: integer;
line, strCanal, strTemp: string;
d: tdatetime;
lines: TStringList;
a, b, c: byte;
mybmp: TBitmap;
MemStr: TMemoryStream;
ArrRgn1: array[1..6] of TPoint;
myRGN1: hrgn;
ArrRgn2: array[1..6] of TPoint;
myRGN2: hrgn;
ArrRgn3: array[1..4] of TPoint;
myRGN3: hrgn;
debugPath, nowData: string;
BKend, BKbegin: integer;
begin
str := PChar(Buffer);
if in_debug then
begin
debugPath := ExtractFilePath(OutFileName);
if not (copy(debugPath, length(debugPath), 1) = '\') then
debugPath := debugPath + '\';
Debugtofile(debugPath, str);
end;
BlockData := BlockData + str;
Bks := TBlocks.Create;
BKend := pos('V2.6', BlockData);
while BKend > 0 do
begin
nowData := copy(BlockData, 1, BKend);
delete(BlockData, 1, BKend);
BKend := pos('V2.6', BlockData);
BKbegin := pos('RESULT', nowData);
if BKbegin > 0 then
begin
try
nowData := copy(nowData, BKbegin, length(nowData) - BKbegin);
lines := TStringList.Create;
lines.Text := nowData;
Bk := TBlock.Create;
Bk.Instrument := DevName;
i := pos('end', nowData);
str := copy(nowData, i, length(nowData) - i - 1);
i := pos('s ', str);
Bk.SampleID := inttostr(strtoint(trim(Copy(str, i + 2, 4))));
Bk.SampleType := 'N';
i := pos('q ', str);
strV := trim(Copy(str, i + 1, 9));
d := strtodate(copy(strv, 7, 2) + '-' + copy(strv, 4, 2) + '-' + copy(strv, 1, 2));
Bk.ExamineDate := formatdatetime('yyyy-mm-dd', d);
lines := TStringList.Create;
lines.Text := nowData;
for i := 0 to 46 do
begin
line := lines[i];
strCanal := line[1];
itemIDX := pos(strCanal, strACanalList);
if itemIDX > 0 then
begin
strV := trim(Copy(line, 2, 7));
strTemp := '';
for m := 1 to length(StrV) do //本次循环将非'+','-','.',阿拉伯数字去掉
if (strV[m] in ['0'..'9']) or (strV[m] = '+') or (strV[m] = '-') or (strV[m] = '.') then
strTemp := strTemp + strV[m];
strV := strTemp;
Bk.AddItem(codeList[itemIDX], '', 'A', strV);
end;
if pos(strCanal, strGCanalList) > 0 then
begin
if strCanal = 'W' then
begin
strCode := 'WBC';
strLineFlag := ']'
end;
if strCanal = 'X' then
begin
strCode := 'RBC';
strLineFlag := '^'
end;
if strCanal = 'Y' then
begin
strCode := 'PLT';
strLineFlag := '_'
end;
if strCanal = 'Z' then
begin
strCode := 'BAS';
strLineFlag := '`'
end;
strCanal := line[1];
mybmp := TBitmap.Create;
mybmp.HandleType := bmDIB;
mybmp.Width := 128;
mybmp.Height := 32;
mybmp.Canvas.moveto(0, 32);
mybmp.Canvas.pen.Color := 0;
mybmp.Canvas.Brush.Color := clwhite;
if pos(strCanal, strGCanalList) > 0 then
begin
strV := copy(line, 3, 128);
m := byte(#30);
for k := 10 to 100 do
begin
b := byte(strV[k]);
if integer(b) > integer(m) then m := b;
end;
a := byte(#32);
m := m - a;
mybmp.Canvas.moveto(0, 1);
mybmp.Canvas.lineto(0, 31);
mybmp.Canvas.lineto(127, 31);
mybmp.Canvas.moveto(0, 31);
for k := 1 to length(strV) do
begin
b := byte(strV[k]);
b := b - a;
mybmp.Canvas.LineTo(k, (32 - trunc(integer(b) * 31 / m)))
end;
mybmp.Canvas.TextOut(100, 2, strCode);
try
mybmp.Canvas.pen.Style := psDot;
strV := '';
for k := 35 to 46 do
if lines[k][1] = strLineFlag then
begin
strV := copy(lines[k], 2, length(lines[k]) - 1)
end;
while length(strv) >= 4 do
begin
m := strtoint(copy(strv, 1, 4));
delete(strv, 1, 4);
mybmp.Canvas.MoveTo(m + 1, 0);
mybmp.Canvas.lineTo(m + 1, mybmp.Height-1);
end;
except
;
end;
MemStr := TMemoryStream.Create;
mybmp.PixelFormat := pf4bit;
mybmp.SaveToStream(MemStr);
mybmp.Free;
m := MemStr.Size;
setlength(strV, m);
MemStr.Seek(0, soBeginning);
MemStr.ReadBuffer(Pointer(strV)^, m);
//MemStr.SaveToFile('e:\1.bmp');
MemStr.Free;
Bk.AddItem(strCode, '', 'G', strV);
end;
end;
if pos(strCanal, strPCanalList) > 0 then
begin
strV := lines[i + 5];
strV := copy(strV, 2, length(strV) - 1);
for m := 1 to 15 do
begin
XorY[m] := strtoint(copy(strV, 4 * (m - 1) + 1, 4));
end;
for m := 1 to 6 do
begin
ArrRgn1[m].X := XorY[rgnP1[m, 1]];
ArrRgn1[m].y := 128 - XorY[rgnP1[m, 2]];
end;
DeleteObject(myRGN1);
myRGN1 := CreatePolygonRgn(ArrRgn1, 6, ALTERNATE);
for m := 1 to 6 do
begin
ArrRgn2[m].X := XorY[rgnP2[m, 1]];
ArrRgn2[m].y := 128 - XorY[rgnP2[m, 2]];
end;
DeleteObject(myRGN2);
myRGN2 := CreatePolygonRgn(ArrRgn2, 6, ALTERNATE);
for m := 1 to 4 do
begin
ArrRgn3[m].X := XorY[rgnP3[m, 1]];
ArrRgn3[m].y := 128 - XorY[rgnP3[m, 2]];
end;
DeleteObject(myRGN3);
myRGN3 := CreatePolygonRgn(ArrRgn3, 4, ALTERNATE);
setlength(binbuf, 1);
strV := copy(line, 3, 4096);
mybmp := TBitmap.Create;
mybmp.HandleType := bmDIB;
mybmp.Width := 128;
mybmp.Height := 128;
mybmp.Canvas.pen.Color := 0;
mybmp.Canvas.Brush.Color := clwhite;
mybmp.Transparent := true;
for j := 0 to 127 do //行
for k := 0 to 15 do //列
begin
str := copy(strV, 32 * j + 2 * k + 1, 2);
hextobin(pchar(str), pchar(binbuf), 2);
c := byte(binbuf[1]);
for m := 0 to 7 do
begin
b := byte(#128);
b := b shr m;
b := b and c;
if integer(b) <> 0 then
begin
if PtInRegion(myRGN1, k * 8 + m, j) then
mybmp.Canvas.Pixels[k * 8 + m, j] := clred
else
if PtInRegion(myRGN2, k * 8 + m, j) then
mybmp.Canvas.Pixels[k * 8 + m, j] := clgreen
else
if PtInRegion(myRGN3, k * 8 + m, j) then
mybmp.Canvas.Pixels[k * 8 + m, j] := clblue
else
mybmp.Canvas.Pixels[k * 8 + m, j] := 0;
end;
end;
end;
mybmp.Canvas.TextOut(4, 4, 'LMNE');
mybmp.Canvas.MoveTo(0, 0);
mybmp.Canvas.lineTo(0, 127);
mybmp.Canvas.lineTo(127, 127);
mybmp.Canvas.lineTo(127, 0);
mybmp.Canvas.lineTo(0, 0);
for m := 1 to 10 do
begin
mybmp.Canvas.MoveTo(XorY[LineSeting1[m, 1]], 128 - XorY[LineSeting1[m, 2]]);
mybmp.Canvas.LineTo(XorY[LineSeting1[m, 3]], 128 - XorY[LineSeting1[m, 4]]);
end;
mybmp.Canvas.pen.Style := psDot;
for m := 1 to 3 do
begin
mybmp.Canvas.MoveTo(XorY[LineSeting2[m, 1]], 128 - XorY[LineSeting2[m, 2]]);
mybmp.Canvas.LineTo(XorY[LineSeting2[m, 3]], 128 - XorY[LineSeting2[m, 4]]);
end;
{ mybmp.Canvas.Brush.Color := clred;
FrameRgn(mybmp.Canvas.Handle, myRGN1, mybmp.Canvas.Brush.Handle, 1, 1);
mybmp.Canvas.Brush.Color := clgreen;
FrameRgn(mybmp.Canvas.Handle, myRGN2, mybmp.Canvas.Brush.Handle, 1, 1);
mybmp.Canvas.Brush.Color := clBlue;
FrameRgn(mybmp.Canvas.Handle, myRGN3, mybmp.Canvas.Brush.Handle, 1, 1);
}
strV := '';
MemStr := TMemoryStream.Create;
mybmp.PixelFormat := pf4bit;
mybmp.SaveToStream(MemStr);
mybmp.Free;
m := MemStr.Size;
setlength(strV, m);
MemStr.Seek(0, soBeginning);
MemStr.ReadBuffer(Pointer(strV)^, m);
Bk.AddItem('LMNE', '', 'P', strV);
MemStr.Free;
DeleteObject(myRGN1);
DeleteObject(myRGN2);
end;
end;
Bks.Add(Bk);
lines.Free;
except
;
end;
end;
end;
if Bks.Count > 0 then
begin
if in_debug then
begin
i := 0;
while FileExists(debugPath + inttostr(i) + '.dug') do
i := i + 1;
Bks.WriteFile(debugPath + inttostr(i) + '.dug');
end;
Bks.WriteFile(OutFileName);
end;
Bks.Free;
end;
procedure DeviceInit(var interval: integer; var SendBuf: PChar);
begin
interval := 0;
SendBuf := '';
end;
function GetDllVersion(DllFile: string; DeviceName: string; Version: string): Boolean;
begin
if ((DllFile = 'PENTRA120.DLL') and (DeviceName = 'PENTRA120') and (Version = '2.0')) then
Result := True
else Result := False;
end;
procedure setdebug(v: boolean);
begin
in_debug := v;
end;
function getdebug: boolean;
begin
result := in_debug;
end;
exports
WriteToFile, DeviceInit, GetDllVersion, setdebug, getdebug;
begin
end.