透過Lpt8255_.pas元件與印表機8255介面卡取得通信 |
|
|
|
jackkcg
站務副站長  發表：891 回覆：1050 積分：848 註冊：2002-03-23 發送簡訊給我 |
此為轉貼資料 原來源位置 庵已經忘記 希望知道之人可以補上 //設計:張勇富 email:ufau0083@ms11.hinet.net //
//1999/4/30 ver:1.0
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 目前區域網路,網際網路的發達日益蓬勃,各式應用層出不窮,不久前在媒體上,得知未來的電腦控制家庭設備正在積極規劃及實驗中,透過網際網路由地球上的一點監控地球上遠方另一點的家電設備的概念產物也正式向世人宣告,這一波流行,如果能跟得上,我想好玩也是值待研究的重點。
為了將原來單一機器上執行的程式,透通性的轉移的網路上,即原始程式不用更改,只要更換元件做簡單的設定即可達到目標是本章的主要想法,要達成這個目的最簡單的方法或許是DCOM離散物件模型,此一技術由於需要系統做大部分的配合而且在Window NT上的效果遠比Window 98上容易,所以留待後面專章討論,本章純就利用Delphi元件的的設計技術,繼承原先單機時的Lpt8255_.pas的元件,保留原屬性之外,另擴充一些網路特性的屬性,而這些擴充的屬性若只透過物件觀測器的設定,而不是在程式中用程式碼撰寫,即可更換元件而達到單機或遠端遙控程式的完成。
以上是將單机元件壙展成網路元件時的架構圖,將Lpt8255_.pas更換成Lpt8255Client.pas的元件,再透過UDP網路協定與Lpt8255ServerWindow.exe程式通信,而程式內部再透過Lpt8255_.pas元件與印表機8255介面卡取得通信。 Lpt8255ServerWindow.exe Lpt8255Client.pas的元件在發展過程中,經過許多次的失敗,其問題的關鍵在那裏呢?如果沒有親自體會一下,就不容易理解,在程式中我為何不用Delphi內附的網路通信元件,而另求他解,主要原因是出在視窗事件驅動的架構,做輸出口指令時是單向沒有問題,而輸入口卻是雙向的事件驅動,不容易用Delphi中元件屬性的方法表達出來,在此提出此事,也期望讀者在閱讀程式時,特別注意輸入口的寫法。
以下列出Lpt8255_.pas及Lpt8255Client.pas可供比較參考。
//**************************************************//
// 印表機介面8255 io 卡 元件 //
//設計:張勇富 email:ufau0083@ms11.hinet.net //
//1999/4/30 ver:1.0
//**************************************************//
//請參考 lpt8255.sch 的電路圖
//印表機的資料埠是在:378h 或3bch 或 278h
//資料埠 bit 0..7 ==>pin2..9
//狀態埠:379h 或3bdh 或 279h
//bit 3..bit6
//控制埠 37ah 或3beh 或 27ah
//bit0:strobe\==>pin 1 ---------------->as Command/ 或 data 的選擇腳
//bit1:auto feed\==>pin14 ---------------->as Command Clock/
unit Lpt8255;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,printers,IniFiles;
const
//命令暫存器的常數定義:74LS377
//bit 7 6 5 4 3 2 1 0
// ---AO DEFAULT:0
// ------A1 DEFAULT:0
// --------CS0/ DEFAULT:1
// -----------CS1/ DEFAULT:1
// ----------------CS2/ DEFAULT:1
// ------------------Write/ DEFAULT:1
// -----------------------Read/ DEFAULT:1
// ----------------------------Read High or Low Nibble/ DEFAULT:1
//以上bit 0..1 ,2..4,5..6,7共分為４組利用或閘運算組合成一個命令位元組送到4ls377
DISABLE_ALL_8255=$FC ; // 11111100
WRITE_8255=$c0 ; // 11000000
READ_HIGH_NIBBLE=$A0 ; // 10100000
READ_LOW_NIBBLE=$20 ; // 00100000
CS0_8255=$18 ; // 00011000
CS1_8255=$14 ; // 00010100
CS2_8255=$0c ; // 00001100
PORTA_ADDRESS =0 ; // 00000000
PORTB_ADDRESS =1 ; // 00000001
PORTC_ADDRESS =2 ; // 00000010
PORTCRTL_ADDRESS =3 ; // 00000011
type
Tport=(porta,portb,portc,portcrtl);
Tlpt8255_ = class(TComponent)
private
{ Private declarations }
//利用印表機資料埠可寫出及讀入時資料相同的特性判斷是否為印表機介面卡安裝之所在
Function IsPrintPort(Address:Word):Boolean;
protected
{ Protected declarations }
//設定印表機介面卡的資料埠位址
FPrinterAddress:word;
//泱定是否可送資料到印表機介面卡
FEnabled:Boolean;
//選擇電路板上三顆８２５子中的一顆
F8255ID:Byte;//select 8255_CS0 ,CS1,CS2 Range 0..2
FPortCrtlData:Byte;
//將命令位元組送到７４ＬＳ３７７
procedure WriteCommand(Command:Byte);
//真正寫資料到８２５５的指令
procedure WritePort(port:TPort;data:byte);virtual;
//真正從８２５５讀取資料的指令
function ReadPort(port:TPort):Byte;virtual;
procedure SetEnabled(Value:Boolean);virtual;
procedure SetPrinterAddress(Value:Word);
public
{ Public declarations }
//送資料到輸出口
procedure OutPortB(Address:Word;data:byte);virtual;
//從輸入口讀取資料
function InPortB(Address:word):byte;virtual;
Constructor Create(AOwner: TComponent); override;
//尋找印表機介面卡安裝之資料埠
Function FindPrintPort:Word;virtual;
//測試電路板上由８２５５ＩＤ所指定的８２５５是否正常
//若有問題會從ｓｔａｔｕｓ傳回錯誤訊息
Function Test8255(var Status:String):Boolean;virtual;
//讀寫８２５子的ＩＤ
procedure Set8255ID(value:byte);virtual;
function Get8255ID:Byte;virtual;
//將３顆８２５５共７２支輸出腳分別讀寫
//bitNo:0..71
//Cs0:PortA[0..7] Portb[8..15],PortC[16..23]
procedure SetBit(BitNo:byte;Value:Boolean);virtual;
Function GetBit(BitNo:Byte):Boolean;virtual;
//讀寫８２５５的４個Ｐｏｒｔ
procedure WritePortA(data:byte);
function ReadPortA:Byte;
procedure WritePortB(data:byte);
function ReadPortB:Byte;
procedure WritePortC(data:byte);
function ReadPortC:Byte;
procedure WritePortCrtl(data:byte);
function ReadPortCrtl:Byte;
//資料格式轉換
// Function ByteToBin(Value:Byte):String;
// Function BinToByte(Value:String):Byte;
// Function ByteToHex(Value:Byte):String;
// Function HexToByte(Value:String):Byte;
property PortAData:byte read ReadPorta write Writeporta;
property PortBData:byte read ReadPortb write Writeportb;
property PortCData:byte read ReadPortc write Writeportc;
property PortCrtlData:byte read readPortCrtl write Writeportcrtl;
published
{ Published declarations }
property ID_8255:byte read Get8255Id write Set8255ID default 0;
Property PrinterAddress:Word read FPrinterAddress write SetPrinterAddress default $378;
property Enabled:boolean read FEnabled write SetEnabled default True;
end;
procedure Register;
implementation
var g_CriticalSection:TRTLCriticalSection;
procedure Register;
begin
RegisterComponents('張勇富', [Tlpt8255_]);
end;
constructor Tlpt8255_.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
InitializeCriticalSection(g_CriticalSection);
FEnabled:=True;
F8255ID:=0;
FPrinterAddress:=$378;
end;
procedure Tlpt8255_.OutPortB(Address:Word;data:byte);
begin
try
asm mov dx,address
mov al,data
out dx,al
end;
except
end;
end;
function Tlpt8255_.InPortB(Address:word):byte;
begin
try
asm mov dx,Address
in al,dx
mov result,al
end;
except
end;
end;
Function Tlpt8255_.IsPrintPort(Address:Word):Boolean;
var Data:byte;
begin
Result:=True;
data:=$ff;
OutPortB(Address,Data);
if data<>InPortB(Address) then begin Result:=False;Exit;end;
data:=$00;
OutPortB(Address,Data);
if data<>InPortB(Address) then begin Result:=False;Exit;end;
data:=$aa;
OutPortB(Address,Data);
if data<>InPortB(Address) then begin Result:=False;Exit;end;
data:=$55;
OutPortB(Address,Data);
if data<>InPortB(Address) then Result:=False;
end;
Function Tlpt8255_.FindPrintPort:Word;
begin
result:=$378;
if IsPrintPort($378) then result:=$378
else if IsPrintPort($3bc) then result:=$3bc
else if IsPrintPort($278) then result:=$278
else Raise Exception.Create('找不到印表機位置或是介面卡故障');
end;
Function Tlpt8255_.Test8255(var Status:String):Boolean;
var testData,ReadBackData:Byte;
Begin
EnterCriticalSection(g_CriticalSection);
Status:='';
Result:=True;
PortCrtlData:=$80;//set all out port
// 當8255的PortA規劃為輸出口,而輸出端有接上輸入設備時會有錯誤的測試結果
//PortB, PortC 都沒有測試到有此現象 ,若欲詳細測試請執行Lpt8255的測試程式
{
TestData:=$55;
PortAData:=TestData;
ReadBackdata:=PortAData;
if TestData<>ReadBackData then begin Result:=False;Status:='PortA=55h error! ';end;
TestData:=$AA;
PortAData:=TestData;
ReadBackdata:=PortAData;
if TestData<>ReadBackData then begin Result:=False;Status:='PortA=aah error! ';end;
}
TestData:=$55;
PortBData:=$55;
if TestData<>PortBData then begin Result:=False;Status:=Status+'PortB=55h error! ';end;
TestData:=$AA;
PortBData:=$AA;
if TestData<>PortBData then begin Result:=False;Status:=Status+'PortB=aah error! ';end;
TestData:=$55;
PortCData:=$55;
if TestData<>PortCData then begin Result:=False;Status:=Status+'PortC=55h error! ';end;
TestData:=$AA;
PortCData:=$AA;
if TestData<>PortCData then begin Result:=False;Status:=Status+'PortC=aah error! ';end;
PortCrtlData:=$ff;
LeaveCriticalSection(g_CriticalSection);
end;
procedure Tlpt8255_.SetEnabled(Value:Boolean);
begin
if Value<>FEnabled then FEnabled:=Value;
end;
procedure Tlpt8255_.SetPrinterAddress(Value:Word);
begin
if Value<>FPrinterAddress then FPrinterAddress:=Value;
end;
procedure Tlpt8255_.Set8255ID(value:byte);
begin
EnterCriticalSection(g_CriticalSection); //避免同一行程,多執行緒的錯誤
if Value>2 then Value:=0;
if Value<>F8255ID then F8255ID:=Value;
LeaveCriticalSection(g_CriticalSection);
end;
function Tlpt8255_.Get8255ID:byte;
begin
EnterCriticalSection(g_CriticalSection);
result:=F8255ID;
LeaveCriticalSection(g_CriticalSection);
end;
procedure Tlpt8255_.WriteCommand(Command:Byte);
Begin
EnterCriticalSection(g_CriticalSection);
//send Command and Clock
OutPortB(FprinterAddress+2,3);//bit 1 bit0= 11
//send Command data
OutPortB(FprinterAddress,Command);
//send Commandand Clock
OutPortB(FprinterAddress+2,1);//bit 1 bit0= 01
LeaveCriticalSection(g_CriticalSection);
end;
procedure Tlpt8255_.WritePort(Port:TPort;data:byte);
var ChipSelect,PortAddress:byte;
begin
if ( csDesigning in ComponentState ) or (csLoading in ComponentState) then exit;
EnterCriticalSection(g_CriticalSection);
PortAddress:=PortA_ADDRESS;
ChipSelect:=CS0_8255;
if Not FEnabled then exit;
case F8255Id of
0:ChipSelect:=CS0_8255;
1:ChipSelect:=CS1_8255;
2:ChipSelect:=CS2_8255;
end;
case Port of
porta:PortAddress:=PortA_ADDRESS;
portb:PortAddress:=PortB_ADDRESS;
portc:PortAddress:=PortC_ADDRESS;
portCrtl:PortAddress:=PortCRTL_ADDRESS;
end;
//write data
OutPortB(FprinterAddress,data);
//enable Data to 74ls373
OutPortB(FprinterAddress+2,0);//bit 1 bit0= 00
WriteCommand(WRITE_8255 or PortAddress or ChipSelect);
WriteCommand(DISABLE_ALL_8255);//gengerator 8255 write Pulse trigger
LeaveCriticalSection(g_CriticalSection);
end;
function Tlpt8255_.ReadPort(port:TPort):Byte;
var ChipSelect,PortAddress:byte;
begin
if ( csDesigning in ComponentState ) or (csLoading in ComponentState) then exit;
EnterCriticalSection(g_CriticalSection);
if Not FEnabled then exit;
case F8255Id of
0:ChipSelect:=CS0_8255;
1:ChipSelect:=CS1_8255;
2:ChipSelect:=CS2_8255;
end;
case Port of
porta:PortAddress:=PortA_ADDRESS;
portb:PortAddress:=PortB_ADDRESS;
portc:PortAddress:=PortC_ADDRESS;
portCrtl:PortAddress:=PortCRTL_ADDRESS;
end;
WriteCommand(READ_LOW_NIBBLE or PortAddress or ChipSelect);
//read Low nibble
Result:=InPortB(FprinterAddress+1) shr 3;
WriteCommand(READ_HIGH_NIBBLE or PortAddress or ChipSelect);
//read High nibble
Result:=((InPortB(FprinterAddress+1) shl 1) and $F0) or Result;
WriteCommand(DISABLE_ALL_8255);
LeaveCriticalSection(g_CriticalSection);
end;
procedure Tlpt8255_.WritePortA(data:byte);
Begin
WritePort(PortA,data);
end;
function Tlpt8255_.ReadPortA:Byte;
Begin
Result:=ReadPort(PortA);
end;
procedure Tlpt8255_.WritePortB(data:byte);
Begin
WritePort(PortB,data);
end;
Function Tlpt8255_.ReadPortB:Byte;
Begin
Result:=ReadPort(PortB);
end;
procedure Tlpt8255_.WritePortC(data:byte);
Begin
WritePort(PortC,data);
end;
Function Tlpt8255_.ReadPortC:Byte;
Begin
Result:=ReadPort(PortC);
end;
function Tlpt8255_.ReadPortCrtl:Byte;
var lpt8255Ini:TIniFile;
Begin
Lpt8255Ini:=TIniFile.Create('Lpt8255.ini');
try
Result:=Lpt8255Ini.ReadInteger('8255 ID '+IntTostr(F8255Id), 'CrtlPort',255);
finally
Lpt8255Ini.Free;
end;
// Result:=ReadPort(PortCrtl);
end;
procedure Tlpt8255_.WritePortCrtl(data:byte);
var lpt8255Ini:TIniFile;
Begin
WritePort(PortCRTL,data);
Lpt8255Ini:=TIniFile.Create('Lpt8255.ini');
try
Lpt8255Ini.WriteInteger('8255 ID '+IntTostr(F8255Id), 'CrtlPort', Data);
finally
Lpt8255Ini.Free;
end;
// FPortCrtlData:=data;
end; procedure Tlpt8255_.SetBit(BitNo:byte;Value:Boolean);
Var ShiftMask,MaskData:Byte;
Port:TPort;
Begin
If ((BitNo>71) or (BitNo<0)) then Raise Exception.Create('Bit Value range error');
Id_8255:=Trunc(BitNo / 24);
case Trunc((BitNo mod 24) /8) of
0:Port:=PortA;
1:Port:=PortB;
2:Port:=PortC;
end;
ShiftMask:=(BitNo mod 24) mod 8;
MaskData:=1;
if Value=True then
begin
Case Port of
PortA:PortAData:=(PortAData or (MaskData shl ShiftMask));
PortB:PortBData:=(PortBData or (MaskData shl ShiftMask));
PortC:PortCData:=(PortCData or (MaskData shl ShiftMask));
end;
end
else//value=False
begin
Case Port of
PortA:PortAData:=(PortAData and (not (MaskData shl ShiftMask)));
PortB:PortBData:=(PortBData and (not (MaskData shl ShiftMask)));
PortC:PortCData:=(PortCData and (not (MaskData shl ShiftMask)));
end;
end;
end;
Function Tlpt8255_.GetBit(BitNo:Byte):Boolean;
Var ShiftMask,MaskData:Byte;
Port:TPort;
Begin
If ((BitNo>71) or (BitNo<0)) then Raise Exception.Create('Bit Value range error');
Id_8255:=Trunc(BitNo / 24);
case Trunc((BitNo mod 24) /8) of
0:Port:=PortA;
1:Port:=PortB;
2:Port:=PortC;
end;
ShiftMask:=(BitNo mod 24) mod 8;
MaskData:=1;
Case Port of
PortA:Result:=(PortAData and (MaskData shl ShiftMask))<>0;
PortB:Result:=(PortBData and (MaskData shl ShiftMask))<>0;
PortC:Result:=(PortCData and (MaskData shl ShiftMask))<>0;
end;
end;
{
Function Tlpt8255_.ByteToBin(Value:Byte):String;
var i:integer;
begin
result:='';
for i:=0 to 7 do
if (Value and (1 shl i)) <>0 then Result:='1' Result
else Result:='0' Result;
end;
Function Tlpt8255_.ByteToHex(Value:Byte):String;
Begin
Result:=IntTohex(Value,2);
end;
Function Tlpt8255_.BinToByte(Value:String):Byte;
var i,len:integer; begin
result:=0;
len:=8;
if StrLen(PChar(Value))<8 then len:=StrLen(PChar(Value));
for i:=1 to len do begin
if Value[i]='1' then result:=result or (1 shl (8-i));
end;
end;
//---------------------------------------------------------
function Exponent(Base,Count:integer):longInt;
var i:integer;
begin
if Count = 0 then
Result:=1
else
begin
Result:=1;
for i:= 1 to Count do
Result:=Result*Base;
end;//...else
end;//...function Exponent
var TransTable:array[0..5] of Integer=(10,11,12,13,14,15);
Function Tlpt8255_.HexToByte(Value:String):Byte;
var I,j,Temp,InPutDataLength:integer;
InPutData:string; begin
InPutData:=Uppercase(value);
InPutDataLength:=Length(Value);
Result:=0;
for i:= 1 to InPutDataLength do
begin
case InPutData[i] of
'0'..'9':
Temp:=StrToInt(InPutData[i]);
'A'..'F':
Temp:=transtable[Ord(InPutData[i])-ord('A')];
end;//...case
Result:=Temp*Exponent(16,InPutDataLength-i) result;
end;//...for
end;//...function
}
end. //************************************************** //
// 印表機介面8255 io 卡,網路client元件 //
//設計:張勇富 email:ufau0083@ms11.hinet.net //
//伺服端配合 Lpt8255ServerWindow.exe Window 95/98/NT//
//1999/5/8 版本:1.0 //
//1999/7/7 增加RegFileName的屬性 //
//************************************************** //
unit Lpt8255Client;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Lpt8255,Winsock,Wsocket,Client8255Server_H,registry; type
{$H }
TLpt8255Client = class(TLpt8255_)
private
Wsocket:Twsocket;//提供UDP 網路傳輸功能的元件
FProtol:string; //可選用 TCP or UDP 協定
FIP:string; //遠端主機的IP
FRemotePort:string; //遠端主機服務的PORT
FLocalPort:string; //本地端主機服務的PORT
FConnect:Boolean;
FReciveTimeOut:integer; //等待SERVER 回傳的最長時間
FDebugReport:boolean; //提供讀寫PORTA,PORTB,PORTC
//若是有錯誤是否舉發例外,
FRegFile:string; // 紀錄網路配置參數
procedure SetIP(Value:string);
Function GetIP:string;
procedure SetRemotePort(Value:string);
Function GetRemotePort:string;
procedure SetLocalPort(Value:string);
Function GetLocalPort:string;
protected
procedure WritePort(port:TPort;Value:byte);override;
function ReadPort(port:TPort):Byte;override;
procedure Loaded;override;
property LocalPort:string read GetLocalPort write SetLocalPort;
property RemotePort:string read GetRemotePort write SetRemotePort; public
Constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetRegFile(Value:string);
Function GetRegFile:String;
function SendRecive(Value:dword):string;
Function Test8255(var Status:String):Boolean;override;
Procedure Set8255ID(value:byte);override;
procedure OutPortB(Address:Word;data:byte);override;
//從輸入口讀取資料
function InPortB(Address:word):byte;override;
// function Get8255ID:Byte; 本函數沿用其祖先所以不會從伺服端讀取
//只會讀本端的8255ID
procedure SetBit(BitNo:byte;Value:Boolean);override;
Function GetBit(BitNo:Byte):Boolean;override;
//procedure SetEnabled(Value:Boolean); 本函數沿用其祖先所以不會從伺服端讀取
//只會讀本端的FENABLED 的變數
property PortAData;
property PortBData;
property PortCData;
property PortCrtlData;
Property PrinterAddress;
published //給物件觀測器叫用的屬性
property RegFileName:string read FRegFile write FRegFile;
property ID_8255;
property Enabled;
property ServerIP:string read GetIP write SetIP;
property ReciveTimeOut_ms:integer read FReciveTimeOut write FreciveTimeOut;
property DebugReport:boolean read FDebugReport write FDebugReport;
end; procedure Register; implementation
//************************************************************************//
procedure Register;
begin
RegisterComponents('張勇富', [TLpt8255Client]);
end;
//**********************************************************************//
Constructor TLpt8255Client.Create(AOwner: TComponent);
Begin
inherited Create(AOwner);
try
Wsocket:=TWsocket.Create(self);
except
raise Exception.Create('Create Client Winsock error!');
end;
FProtol:='udp';
FremotePort:='1111';
FLocalPort:='9999';
FConnect:=False;
Fip:='255.255.255.255';
FReciveTimeOut:=250; // 250MS 當網路通信速度變慢時,最好數值用較大些
FDebugReport:=False;
end;
//**********************************************************************//
procedure Tlpt8255Client.Loaded;
begin
inherited;
GetRegFile;
end;
destructor TLpt8255Client.Destroy;
begin
Wsocket.free;
inherited;
end;
procedure TLpt8255Client.SetRegFile(Value:string);
var regFile:TregIniFile; begin
if CsDesigning in ComponentState then exit;
if Value<>FregFile then FRegFile:=Value;
if FregFile='' then exit;
Try
RegFile:=TRegIniFile.Create('Lpt8255Client');
RegFile.WriteString(FregFile,'Remote local', FIP);
RegFile.WriteInteger(FregFile,'Recive TimeOut',FReciveTimeOut);
if FDebugReport then
RegFile.WriteString(FregFile,'Debug Report','True')
else
RegFile.WriteString(FregFile,'Debug Report','False');
Finally
RegFile.Free;
end;
end;
Function TLpt8255Client.GetRegFile:String;
var regFile:TregIniFile;
TempIp:string;
TempTimeOut:integer;
TempBool:string;
begin
if FregFile='' then exit;
Try
RegFile:=TRegIniFile.Create('Lpt8255Client');
TempIP:=RegFile.ReadString(FregFile,'Remote local','');
if TempIP<>'' then FIP:=TempIP;
TempTimeOut:=RegFile.ReadInteger(FregFile,'Recive TimeOut',0);
if TempTimeOut<>0 then FReciveTimeOut:=TempTimeOut;
TempBool:=RegFile.ReadString(FregFile,'Debug Report','');
if TempBool<>'' then if
TempBool='True' then FDebugReport:=True
else FDebugReport:=False;
Finally
RegFile.Free;
result:=FregFile;
end;
end;
procedure TLpt8255Client.SetIP(Value:string); begin
// if FConnect then raise Exception.Create(' 連線中不可更改 IP')
// else if (Value<>FIP) then FIP:=Value;
if (Value<>FIP) then FIP:=Value;
end;
Function TLpt8255Client.GetIP:string;
begin
result:=FIP;
end;
procedure TLpt8255Client.SetRemotePort(Value:string);
begin
if (Value<>FRemotePort) then FRemotePort:=Value;
end;
Function TLpt8255Client.GetRemotePort:string;
begin
result:=FRemotePort;
end;
procedure TLpt8255Client.SetLocalPort(Value:string);
begin
// if FConnect then raise Exception.Create(' 連線中不可更改 Local PORT')
// else if (Value<>FLocalPort) then FLocalPort:=Value;
if (Value<>FLocalPort) then FLocalPort:=Value;
end;
Function TLpt8255Client.GetLocalPort:string;
begin
result:=FLocalPort;
end;
//***********************************************************//
//命令格式是４個位元組,以十六進制表示如下格式 //
//ccccppdd cccc共２個位元組是命令种類 //
// pp共１個位元組表示Port 或 BitNo //
// dd共１個位元組表示 port 的值 0..255 //
// 或是 SetBit otr GetBit //
//***********************************************************//
//1999/7/5 修改為下列格式
//***********************************************************//
//命令格式是４個位元組,以十六進制表示如下格式 //
//ccppppdd cc共1 個位元組是命令种類 //
// pppp共2個位元組表示Port 或 BitNo 或I/O位址 //
// dd共１個位元組表示 port 的值 0..255 //
// 或是 SetBit //
// 或是 OutportB //
//***********************************************************//
Function TLpt8255Client.SendRecive(Value:dword):String;
var Buffer:string;
TimeOut:integer;
begin
//當元件在設計或載入階段立刻離開本函數
if (csDesigning in ComponentState) or (csLoading in ComponentState) then exit;
if not FEnabled then exit;
//每次傳輸狀態未完全結束時,不執行,所以若傳送資料速度大於處理速度時
//資料將會漏失
if Wsocket.State<>wsClosed then exit;
WSocket.Proto := FProtol;
WSocket.Addr := FIP;
WSocket.Port := FRemotePort;
WSocket.LocalPort := FLocalPort;
WSocket.Connect;//開始通信連線
FConnect:=True;
WSocket.SendStr(IntTostr(Value)); //傳送一筆資料
//ReadLine(timeOut,Buffer) 是直接向遙控主機讀取回送資訊
//若是在timeout用完之後,沒有資訊則buffer為空,若是有有資訊
//也要在timout 用完之後才能返回,意界是此指令一定要浪費
//timeout的時間才能完成
buffer:='';
TimeOut:=0;
while (buffer='') do begin
Wsocket.ReadLine(-1,Buffer);//1 ms
inc(timeout);
if Timeout >FReciveTimeOut then begin
buffer:=WaitReciveTimeOut;
break;
end;//if
end;//while
//解決ReadLine Timeout不用完就不返回的問題
WSocket.Close;//關閉本次傳輸
FConnect:=False;
result:=Buffer;//伺服端傳回的資料
end;
//*********************************************************************//
//本函數最好在開始執行控制前執行,一來確定伺服端是否存在,二來介面卡是否有故障
Function TLpt8255Client.Test8255(var Status:String):Boolean;
var Temp:string;
tempEnabled:boolean;
begin
TempEnabled:=enabled;//保留原來的Enabled,避免被本函數破坯
enabled:=True;
ID_8255:=F8255ID;//同步伺服端與Client 中8255的ID
Temp:= SendRecive(Test8255Msg);
if Temp=TESTOK then begin
Status:='';
result:=True;
end else begin
Status:=Temp;
result:=False;
end;
enabled:=False;
Enabled:=Tempenabled;
end;
//*********************************************************************//
Procedure TLpt8255Client.Set8255ID(value:byte);
var Temp:string;
begin
inherited;
if (csDesigning in ComponentState) or (csLoading in ComponentState) then exit;
case Value of
0:begin
remotePort:='1111';
LocalPort:='9999';
end;
1:begin
remotePort:='2222';
LocalPort:='8888';
end;
2:begin
remotePort:='3333';
LocalPort:='7777';
end;
end;
if not FEnabled then exit;
inherited;
Temp:= SendRecive(Set8255IDMsg or Value);//傳送命令舉8255ID的值
if (Temp<>Set8255IDOK) and DebugReport then
raise Exception.Create(Set8255IDFail);
end ;
//*********************************************************************//
procedure TLpt8255Client.WritePort(port:TPort;Value:byte);
var temp:string;
Begin
if not FEnabled then exit;
case port of
PORTA:begin
Temp:= SendRecive(WritePortAMsg or Value);
//當寫入錯誤時,若舉發錯誤,就會產生一個提示視窗
//若快速寫入而且一直錯誤,可能會因產生太多視窗而當機
//所以慢速而且安全的傳輸是必要的,可令DebugReport:=True
if (Temp<>WriteOK) and DebugReport then
raise Exception.Create(WritePortAFail);
end;
PORTB:begin
Temp:= SendRecive(WritePortBMsg or Value);
if (Temp<>WriteOK) and DebugReport then
raise Exception.Create(WritePortBFail);
end;
PORTC:begin
Temp:= SendRecive(WritePortCMsg or Value);
if (Temp<>WriteOK) and DebugReport then
raise Exception.Create(WritePortCFail);
end;
PORTCRTL:begin
Set8255ID(F8255ID);
Temp:= SendRecive(WritePortCRTLMsg or Value);
if (Temp<>WriteOK) and DebugReport then
raise Exception.Create(WritePortCRTLFail);
end;
end;//case
end;
function TLpt8255Client.ReadPort(port:TPort):Byte;
var temp:string;
Begin
if not FEnabled then exit;
case port of
PORTA:begin
Temp:= SendRecive(ReadPortAMsg);
try
//讀回的資料若不能轉換成整數就是錯誤,而且會舉發例外
//而在except的區塊中處理
result:=StrToInt(temp);
except
result:=255;
if DebugReport then raise Exception.Create(ReadPortAFail);
end;
end;
PORTB:begin
Temp:= SendRecive(ReadPortBMsg);
try
result:=StrToInt(temp);
except
result:=255;
if DebugReport then raise Exception.Create(ReadPortBFail);
end;
end;
PORTC:begin
Temp:= SendRecive(ReadPortCMsg);
try
result:=StrToInt(temp);
except
result:=255;
if DebugReport then raise Exception.Create(ReadPortCFail);
end;
end;
PORTCRTL:begin
Temp:= SendRecive(ReadPortCRTLMsg);
try
result:=StrToInt(temp);
except
result:=255;
if DebugReport then raise Exception.Create(ReadPortCRTLFail);
end;
end;
end;//case end;
//*********************************************************************//
procedure TLpt8255Client.SetBit(BitNo:byte;Value:Boolean);
var temp:string;
tempValue:integer;
Begin
if not FEnabled then exit;
if Value then TempValue:=1 else tempValue:=0; Temp:= SendRecive(SetBitMsg or (BitNo shl 8) or TempValue);
if (Temp<>SetBitOK) and DebugReport then
raise Exception.Create(SetBitFail);
end;
//*********************************************************************//
Function TLpt8255Client.GetBit(BitNo:Byte):Boolean;
var temp:string;
tempValue:integer;
Begin
if not FEnabled then exit;
Temp:= SendRecive(GetBitMsg or (BitNo shl 8));
try
StrToInt(temp);//讀回的資料若不能轉換成整數就是錯誤,而且會舉發例外
//而在except的區塊中處理
if temp='0' then result:=False else result:=True;
except
result:=True;
if DebugReport then raise Exception.Create(GetBitFail);
end;
end;
//---------------------------------------------------------
procedure TLpt8255Client.OutPortB(Address:word;data:byte);
var temp:string;
Begin
if not FEnabled then exit;
Temp:= SendRecive(OutPortBMsg or (Address shl 8) or data);
if (Temp<>OutPortBOK) and DebugReport then
raise Exception.Create(OutPortBFail);
end;
//*********************************************************************//
Function TLpt8255Client.InportB(Address:word):Byte;
var temp:string;
tempValue:integer;
Begin
if not FEnabled then exit;
Temp:= SendRecive(InportBMsg or (Address shl 8));
try
result:=StrToInt(temp);//讀回的資料若不能轉換成整數就是錯誤,而且會舉發例外
//而在except的區塊中處理
except
result:=0;
if DebugReport then raise Exception.Create(InportBFail);
end;
end; end. *********************************************************
哈哈&兵燹
最會的2大絕招 這個不會與那個也不會 哈哈哈 粉好 Delphi K.Top的K.Top分兩個字解釋Top代表尖端的意思,希望本討論區能提供Delphi的尖端新知
K.表Knowlege 知識,就是本站的標語:Open our mind to make knowledge together!
希望能大家敞開心胸,將知識寶庫結合一起
------
********************************************************** 哈哈&兵燹 最會的2大絕招 這個不會與那個也不會 哈哈哈 粉好 Delphi K.Top的K.Top分兩個字解釋Top代表尖端的意思,希望本討論區能提供Delphi的尖端新知 K.表Knowlege 知識,就是本站的標語:Open our mind |
發表時間：2003-07-18 17:06:05
IP:61.221.xxx.xxx 未訂閱
系統時間：2024-05-09 9:53:38
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |