📄 awkermit.pas
字号:
(***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower Async Professional
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1991-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
{*********************************************************}
{* AWKERMIT.PAS 4.06 *}
{*********************************************************}
{* Kermit protocol *}
{*********************************************************}
{Global defines potentially affecting this unit}
{$I AWDEFINE.INC}
{Options required for this unit}
{$V-,I-,B-,F+,A-,X+}
unit AwKermit;
{-Provides Kermit receive and transmit functions}
interface
uses
WinTypes,
WinProcs,
Messages,
SysUtils,
OoMisc,
AwUser,
AwTPcl,
AwAbsPcl,
AdPort;
const
{Constants}
DefMinRepeatCnt = 4; {Minimum characters to use repeat prefix}
FastAbort = False; {Use Error packet for aborting}
DefHibitPrefix = '&'; {Default char for hibit prefixing}
CancelWait = 182; {Wait 10 seconds for cancel transmit}
DiscardChar = 'D'; {For signaling an abort}
MaxWindowSlots = 27; {Avoids MS-Kermit bug}
{For estimating protocol transfer times}
KermitOverhead = 20; {Bytes of overhead for each block}
KermitTurnDelay = 1000; {Msecs of turn around delay}
SWCKermitTurnDelay = 0; {Msecs of turn around delay on SWC xfers}
{#Z+}
{Packet types}
KBreak = 'B'; {Break transmission (EOT)}
KData = 'D'; {Data packet}
KError = 'E'; {Error packet}
KFile = 'F'; {File header packet}
KNak = 'N'; {Negative acknowledge packet}
KSendInit = 'S'; {Initial packet (exchange options)}
KDisplay = 'X'; {Display text on screen packet}
KAck = 'Y'; {Acknowledge packet}
KEndOfFile = 'Z'; {End of file packet}
{#Z-}
const
{Default kermit options (from the Kermit Protocol Manual)}
DefKermitOptions : TKermitOptions =
(MaxPacketLen : 80; {80 characters}
MaxTimeout : 5; {5 seconds}
PadCount : 0; {No pad chars}
PadChar : #0; {Null pad char}
Terminator : cCR; {Carriage return}
CtlPrefix : '#'; {'#' char}
HibitPrefix : 'Y'; {Space means no hibit prefixing}
Check : '1'; {1 byte chksum}
RepeatPrefix : '~'; {Default repeat prefix}
CapabilitiesMask : 0; {No default extended caps}
WindowSize : 0; {No default windows}
MaxLongPacketLen : 0); {No default long packets}
{#Z+}
{Default kermit options (from the Kermit Protocol Manual)}
MissingKermitOptions : TKermitOptions =
(MaxPacketLen : 80; {80 characters}
MaxTimeout : 5; {5 seconds}
PadCount : 0; {No pad chars}
PadChar : #0; {Null pad char}
Terminator : cCR; {Carriage return}
CtlPrefix : '#'; {'#' char}
HibitPrefix : ' '; {No hibit prefixing}
Check : '1'; {1 byte chksum}
RepeatPrefix : ' '; {Default repeat prefix}
CapabilitiesMask : 0; {No default extended caps}
WindowSize : 0; {No default windows}
MaxLongPacketLen : 0); {No default long packets}
{#Z-}
{Constructors/destructors}
function kpInit(var P : PProtocolData; H : TApdCustomComPort;
Options : Cardinal) : Integer;
procedure kpDone(var P : PProtocolData);
function kpReinit(P : PProtocolData) : Integer;
procedure kpDonePart(P : PProtocolData);
{Options}
function kpSetKermitOptions(P : PProtocolData; KOptions : TKermitOptions) : Integer;
function kpSetMaxPacketLen(P : PProtocolData; MaxLen : Byte) : Integer;
function kpSetMaxLongPacketLen(P : PProtocolData; MaxLen : Cardinal) : Integer;
function kpSetMaxWindows(P : PProtocolData; MaxNum : Byte): Integer;
function kpSetSWCTurnDelay(P : PProtocolData; TrnDelay : Cardinal) : Integer;
function kpSetMaxTimeoutSecs(P : PProtocolData; MaxTimeout : Byte) : Integer;
function kpSetPacketPadding(P : PProtocolData; C : Char; Count : Byte) : Integer;
function kpSetTerminator(P : PProtocolData; C : Char) : Integer;
function kpSetCtlPrefix(P : PProtocolData; C : Char) : Integer;
function kpSetHibitPrefix(P : PProtocolData; C : Char) : Integer;
function kpSetRepeatPrefix(P : PProtocolData; C : Char) : Integer;
function kpSetKermitCheck(P : PProtocolData; CType : Byte) : Integer;
function kpGetSWCSize(P : PProtocolData) : Byte;
function kpGetLPStatus(P : PProtocolData;
var InUse : Bool;
var PacketSize : Cardinal) : Integer;
function kpWindowsUsed(P : PProtocolData) : Byte;
{Control}
procedure kpPrepareReceive(P : PProtocolData);
procedure kpReceive(Msg, wParam : Cardinal;
lParam : LongInt);
procedure kpPrepareTransmit(P : PProtocolData);
procedure kpTransmit(Msg, wParam : Cardinal;
lParam : LongInt);
implementation
const
{'S' - SendInit packet option index}
MaxL = 1; {Max packet length sender can receive (Def = none)}
Time = 2; {Max seconds to wait before timing out (Def = none)}
NPad = 3; {Number of padding chars before packets (Def = none)}
PadC = 4; {Padding character (Def = Nul)}
EOL = 5; {Packet terminator character (Def = CR)}
QCtl = 6; {Prefix char for control-char encoding (Def = #)}
QBin = 7; {Prefix char for hi-bit encoding (Def = ' ' none)}
Chkt = 8; {1=chksum, 2=2 byte chksum, 3=CRC (Def = 1)}
Rept = 9; {Prefix char for repeat-count encoding (Def = ' ' none)}
Capa = 10; {Advanced capabilities bit masks}
Windo = 11; {Size of the sliding window (in packets)}
MaxLx1 = 12; {long packet size div 95}
MaxLx2 = 13; {Long packet size mod 95}
SendInitLen = 13; {Size of SendInit data block}
MaxKermitOption = 13;
{Advanced capability bit masks}
LastMask = $01; {Set if more bit masks follow}
LongPackets = $02; {Set if using long packets}
SlidingWindows = $04; {Set if using sliding windows}
FileAttribute = $08; {Set if using Attribut packets, not supported}
{Text strings for various error/abort conditions}
eRecInitTO = 'Timeout waiting for RecInit packet';
eFileTO = 'Timeout waiting for File packet';
eDataTO = 'Timeout waiting for Data packet';
eSync = 'Failed to syncronize protocol';
eAsync = 'Blockcheck or other error';
eCancel = 'Canceled';
eFileExists = 'Not allowed to overwrite existing file';
eFileError = 'Error opening or writing file';
{Check to aCheckType conversion array}
CheckVal : array[1..3] of Byte = (bcChecksum1, bcChecksum2, bcCrcK);
{Used in ProtocolReceivePart/ProtocolTransmitPart}
FirstDataState : array[Boolean] of TKermitDataState = (dskData, dskCheck1);
FreeMargin = 20;
aDataTrigger = 0;
LogKermitState : array[TKermitState] of TDispatchSubType = (
dsttkInit, dsttkInitReply, dsttkCollectInit, dsttkOpenFile,
dsttkSendFile, dsttkFileReply, dsttkCollectFile, dsttkCheckTable,
dsttkSendData, dsttkBlockReply, dsttkCollectBlock, dsttkSendEof,
dsttkEofReply, dsttkCollectEof, dsttkSendBreak, dsttkBreakReply,
dsttkCollectBreak, dsttkComplete, dsttkWaitCancel, dsttkError,
dsttkDone, dstrkInit, dstrkGetInit, dstrkCollectInit,
dstrkGetFile, dstrkCollectFile, dstrkGetData, dstrkCollectData,
dstrkComplete, dstrkWaitCancel, dstrkError, dstrkDone);
{$IFDEF Win32}
function ToChar(C : Char) : Char;
{-Returns C+$20}
asm
add al,$20;
end;
function UnChar(C : Char) : Char;
{-Returns C-$20}
asm
sub al,$20
end;
function Ctl(C : Char) : Char;
{-Returns C xor $40}
asm
xor al,$40
end;
function Inc64(W : Cardinal) : Cardinal;
{-Returns (W+1) mod 64}
asm
inc ax
and ax,$3F
end;
function Dec64(W : Cardinal) : Cardinal;
{-Returns (W-1) or 63 if W=0}
asm
dec ax
jns @@done
mov ax,63
@@done:
end;
function IsCtl(C : Char) : Bool;
begin
IsCtl := (C <= #31) or (C = #127);
end;
function IsHiBit(C : Char) : Bool;
begin
IsHiBit := (Ord(C) and $80) <> 0;
end;
function HiBit(C : Char) : Char;
asm
or ax,$80
end;
{$ELSE}
function ToChar(C : Char) : Char;
{-Returns C+$20}
inline(
$58/ {POP AX ;AX = C}
$05/$20/$00); {ADD AX,$20 ;AX = C + $20}
function UnChar(C : Char) : Char;
{-Returns C-$20}
inline(
$58/ {POP AX ;AX = C}
$2D/$20/$00); {SUB AX,$20 ;AX = C - $20}
function Ctl(C : Char) : Char;
{-Returns C xor $40}
inline(
$58/ {POP AX ;AX = C}
$35/$40/$00); {XOR AX,$40 ;Toggle bit 6}
function Inc64(W : Cardinal) : Cardinal;
{-Returns (W+1) mod 64}
inline(
$58/ {POP AX ;AX = W}
$40/ {INC AX ;Inc(AX)}
$25/$3F/$00); {AND AX,$3F ;AX mod 64}
function Dec64(W : Cardinal) : Cardinal;
{-Returns (W-1) or 63 if W=0}
inline(
$58/ {POP AX ;AX = W}
$48/ {DEC AX ;Dec(AX)}
$79/$03/ {JNS Done ;Done if sign didn't change}
$B8/$3F/$00); {MOV AX,63 ;else AX := 63}
{Done:}
function IsCtl(C : Char) : Bool;
Inline(
$58/ { POP AX ;AX = C}
$25/$7F/$00/ { AND AX, $07F ;Low 7 bits only}
$3D/$20/$00/ { CMP AX, $020 ;In 0-31 range?}
$7D/$06/ { JGE No1 ;No, continue}
$B8/$01/$00/ { MOV AX,1 ;It's a ctl char}
$E9/$0E/$00/ { JMP Done ;Leave}
{ No1:}
$3D/$7F/$00/ { CMP AX, $07F ;= 127?}
$75/$06/ { JNE No2 ;No, continue}
$B8/$01/$00/ { MOV AX,1 ;It's a ctl char}
$E9/$03/$00/ { JMP Done ;Leave}
{ No2: ;Not a ctl char}
$B8/$00/$00); { MOV AX,0 ;}
{ Done:}
function IsHiBit(C : Char) : Bool;
Inline(
$58/ {POP AX ;AX = C}
$A9/$80/$00/ {TEST AX,$80 ;In 0-127 range?}
$75/$06/ {JNZ No1 ;No, continue}
$B8/$00/$00/ {MOV AX,0 ;It's a low-bit char}
$E9/$03/$00/ {JMP Done ;Leave}
{No1:}
$B8/$01/$00); {MOV AX,1 ;}
{Done:}
function HiBit(C : Char) : Char;
Inline(
$58/ { POP AX}
$0D/$80/$00); { OR AX, $80}
{$ENDIF}
procedure kpFinishWriting(P : PProtocolData);
{-Handle "discard" option}
begin
with P^ do begin
if aFileOpen then begin
{Let parent close file}
aapFinishWriting(P);
{Discard the file if asked to do so}
if (kActualDataLen >= 1) and (aDataBlock^[1] = DiscardChar) then begin
Erase(aWorkFile);
if IOResult = 0 then ;
end;
end;
end;
end;
procedure kpAllocateWindowTable(P : PProtocolData);
{-Allocate the window table}
begin
with P^ do
{Allocate sliding window data table}
kDataTable := AllocMem(kTableSize*aBlockLen);
end;
procedure kpDeallocateWindowTable(P : PProtocolData);
{-Deallocate current window table}
begin
with P^ do
FreeMem(kDataTable, kTableSize*aBlockLen);
end;
procedure kpRawInit(P : PProtocolData);
{-Do low-level initializations}
begin
with P^ do begin
aCurProtocol := Kermit;
aFileOfs := 0;
aBlockLen := DefKermitOptions.MaxPacketLen;
aFileOpen := False;
kUsingHibit := False;
kUsingRepeat := False;
kKermitOptions := DefKermitOptions;
kPacketType := ' ';
kMinRepeatCnt := DefMinRepeatCnt;
aBatchProtocol := True;
kLPInUse := False;
apResetReadWriteHooks(P);
end;
end;
function kpInit(var P : PProtocolData; H : TApdCustomComPort;
Options : Cardinal) : Integer;
{-Allocates and initializes a protocol control block with options}
begin
{Check for adequate output buffer size}
if H.OutBuffUsed + H.OutBuffFree < 1024 then begin
kpInit := ecOutputBufferTooSmall;
Exit;
end;
{Allocate the protocol data record}
if apInitProtocolData(P, H, Options) <> 0 then begin
kpInit := ecOutOfMemory;
Exit;
end;
with P^ do begin
aDataBlock := nil;
kWorkBlock := nil;
kDataTable := nil;
kpRawInit(P);
aOverhead := KermitOverhead;
aTurnDelay := KermitTurnDelay;
kSWCTurnDelay := SWCKermitTurnDelay;
apFinishWriting := kpFinishWriting;
kKermitOptions := DefKermitOptions;
with kKermitOptions do begin
if MaxLongPacketLen = 0 then
aBlockLen := MaxPacketLen
else
aBlockLen := MaxLongPacketLen;
if WindowSize = 0 then
kTableSize := 1
else
kTableSize := WindowSize;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -