📄 hw_32.pas

📁 关于利用DELPHI来进行企业级方案解决的著作的附书源码
💻 PAS
📖 第 1 页 / 共 3 页
字号:
上一页 1 23
     PortNumber:DWORD;
     DataPort  :DWORD;
    end;
begin
  if not ActiveHW then Exit;
  if HardAccess then
  begin
    Rec.PortNumber:=PortAddr; Rec.DataPort:=nNewValue;
    DeviceIoControl(hDRV,
                    CtlCode(_DRV_HARD_WRITE_PORTW),
                    @Rec,8,NIL,0,
                    nByte,pOverlapped(NIL));
  end
  else begin
         asm
           mov ax,nNewValue
           mov dx,PortAddr
           out dx,ax
         end;
       end;
end;

procedure   TVicHW32.SetPortL(PortAddr : Word; nNewValue: DWORD);
var nByte : DWORD;
    Rec   : record
     PortNumber:DWORD;
     DataPort  :DWORD;
    end;
begin
  if not ActiveHW then Exit;
  if HardAccess then
  begin
    Rec.PortNumber:=PortAddr; Rec.DataPort:=nNewValue;
    DeviceIoControl(hDRV,
                    CtlCode(_DRV_HARD_WRITE_PORTL),
                    @Rec,6,NIL,0,
                    nByte,pOverlapped(NIL));
  end
  else begin
         asm
           mov eax,nNewValue
           mov dx,PortAddr
           out dx,eax
         end;
       end;
end;

procedure   TVicHW32.PortControl(Ports:pPortRec; NumPorts:Word);
var nByte : DWORD;
    size     : DWORD;
begin
  if not ActiveHW then Exit;
  Size:=4*NumPorts;
  DeviceIoControl(hDRV,
                  CtlCode(_DRV_PORT_CONTROL),
                  Ports,size,
                  Ports,size,
                  nByte,pOverlapped(NIL));
end;

procedure   TVicHW32.ReadPortFIFO ( PortAddr:Word; NumPorts:Word; var Buffer);
type TPortRec = record
       PortAddr : Word;
       size  : Word;
       Buf   : array[1..2] of Byte;
     end;
var nByte    : DWORD;
    PortRec  :^TPortRec;
begin
  if not ActiveHW then Exit;

  if fHardAccess then
  begin

    GetMem(PortRec,4+NumPorts);
    PortRec^.PortAddr:=PortAddr;
    PortRec^.size:=NumPorts;

    DeviceIOControl(hDRV,
                    CtlCode(_DRV_READ_FIFO),
                    PortRec,NumPorts+4,
                    PortRec,NumPorts+4,
                    nByte,pOverlapped(NIL));
    Move(PortRec^.Buf,Buffer,NumPorts);
    FreeMem(PortRec);
  end
  else
  begin
    nByte:=DWORD(@Buffer);
    asm
      cld
      mov dx,PortAddr
      xor ecx,ecx
      mov cx,NumPorts
      mov edi,nByte
      rep insb
    end;
  end;  
end;

procedure   TVicHW32.WritePortFIFO( PortAddr:Word; NumPorts:Word; var Buffer);
type TPortRec = record
       PortAddr : Word;
       size  : Word;
       Buf   : array[1..2] of Byte;
     end;
var nByte    : DWORD;
    PortRec  :^TPortRec;
begin
  if not ActiveHW then Exit;
  if fHardAccess then
  begin
    GetMem(PortRec,4+NumPorts);
    PortRec^.PortAddr:=PortAddr;
    PortRec^.size:=NumPorts;
    Move(Buffer,PortRec^.Buf,NumPorts);
    DeviceIOControl(hDRV,
                    CtlCode(_DRV_WRITE_FIFO),
                    PortRec,NumPorts+4,
                    PortRec,NumPorts+4,
                    nByte,pOverlapped(NIL));
    FreeMem(PortRec);
  end
  else
  begin
    nByte:=DWORD(@Buffer);
    asm
      cld
      mov dx,PortAddr
      xor ecx,ecx
      mov cx,NumPorts
      mov esi,nByte
      rep outsb
    end;
  end;

end;
procedure   TVicHW32.ReadPortWFIFO ( PortAddr:Word; NumPorts:Word; var Buffer);
type TPortRec = record
       PortAddr : Word;
       size  : Word;
       Buf   : array[1..2] of Word;
     end;
var nByte    : DWORD;
    PortRec  :^TPortRec;
begin
  if not ActiveHW then Exit;
 if fHardAccess then
  begin

    GetMem(PortRec,4+2*NumPorts);
    PortRec^.PortAddr:=PortAddr;
    PortRec^.size:=NumPorts;
    DeviceIOControl(hDRV,
                    CtlCode(_DRV_READ_FIFO_WORD),
                    PortRec,2*NumPorts+4,
                    PortRec,2*NumPorts+4,
                    nByte,pOverlapped(NIL));
    Move(PortRec^.Buf,Buffer,2*NumPorts);
    FreeMem(PortRec);
  end
  else
  begin

    nByte:=DWORD(@Buffer);
    asm
      cld
      mov dx,PortAddr
      xor ecx,ecx
      mov cx,NumPorts
      mov edi,nByte
      rep insw
    end;
  end;

end;

procedure   TVicHW32.WritePortWFIFO( PortAddr:Word; NumPorts:Word; var Buffer);
type TPortRec = record
       PortAddr : Word;
       size  : Word;
       Buf   : array[1..2] of Word;
     end;
var nByte    : DWORD;
    PortRec  :^TPortRec;
begin
  if not ActiveHW then Exit;
  if fHardAccess then
  begin
    GetMem(PortRec,4+2*NumPorts);
    PortRec^.PortAddr:=PortAddr;
    PortRec^.size:=NumPorts;
    Move(Buffer,PortRec^.Buf,2*NumPorts);
    DeviceIOControl(hDRV,
                    CtlCode(_DRV_WRITE_FIFO_WORD),
                    PortRec,2*NumPorts+4,
                    PortRec,2*NumPorts+4,
                    nByte,pOverlapped(NIL));
    FreeMem(PortRec);
  end
  else
  begin
    nByte:=DWORD(@Buffer);
    asm
      cld
      mov dx,PortAddr
      xor ecx,ecx
      mov cx,NumPorts
      mov esi,nByte
      rep outsw
    end;
  end;

end;

function  TVicHW32.MapPhysToLinear(PhAddr:DWORD; PhSize:DWORD):Pointer;
var nByte : DWORD;
    MP    : Pointer;
    var i : Byte;
begin

  Result:=NIL;
  if (not fOpenDrive) then Exit;

  for i:=1 to fMappedAreas do
    if PhAddr = fMappedAddresses[i] then
    begin
      Result :=	fMappedPointers[i];
      Exit;
    end;

  if fMappedAreas = MaxMappedAreas then Exit;

  fMemorySize := PhSize;
  fPhysLoPart := PhAddr;
  DeviceIoControl(hDrv,
		  CtlCode(_DRV_MAP_MEMORY),
                  @fInterface,24,
                  @MP, 4,
                  nByte, POverlapped(NIL));
  Inc(fMappedAreas);
  fMappedSizes[fMappedAreas]     := PhSize;
  fMappedPointers[fMappedAreas]  := MP;
  fMappedAddresses[fMappedAreas] := PhAddr;

  Result := MP;
end;



procedure TVicHW32.UnmapMemory(PhAddr:DWORD; PhSize:DWORD);
var nByte : DWORD;
    i,j   : Byte;
begin
  if not fOpenDrive then Exit;
  i:=1;
  while i <= fMappedAreas do
  begin
    if PhAddr=fMappedAddresses[i] then
    begin
      DeviceIOControl(hDrv,
                      CtlCode(_DRV_UNMAP_MEMORY),
                      @fMappedPointers[i],4,
                      NIL,0,
                      nByte,POverlapped(NIL));
      for j:=i to (fMappedAreas-1) do
      begin
        fMappedAddresses[j]:= fMappedAddresses[j+1];
        fMappedPointers[j] := fMappedPointers[j+1];
        fMappedSizes[j]    := fMappedSizes[j+1];
      end;
      Dec(fMappedAreas);
    end
    else Inc(i);
  end;
end;

procedure   TVicHW32.SetHardAccess(Parm : Boolean);
var code,nByte : DWORD;
begin
  if not fWin95 then
  begin
    if Parm then code:=CtlCode(_DRV_HARD_ACCESS)
            else code:=CtlCode(_DRV_SOFT_ACCESS);
    DeviceIoControl(hDRV,
                  Code,
                  NIL,0,NIL,0,
                  nByte,pOverlapped(NIL));
  end;
  fHardAccess:=PARM;
end;

procedure TVicHW32.SetLPTNumber(nNewValue  : Byte);
begin
  if fOpenDrive and (nNewValue<=fLPTs) then
  begin
    fLPTBasePort := fLPTAddresses^[nNewValue];
    {$ifdef DEB_NOT_LPT}
       PLockedBuffer(fpLockedMemory)^.LPT_BASE_PORT := $300;
    {$ELSE}
       PLockedBuffer(fpLockedMemory)^.LPT_BASE_PORT := fLPTBasePort;
    {$ENDIF}
    fDataPorts[0]:=0;
    fDataPorts[1]:=0;
    fDataPorts[2]:=0;
    fLPTNumber := nNewValue;
  end;
end;

procedure TVicHW32.LPTStrobe;
var i : Word;
begin
  if (not fOpenDrive) then Exit;
  SetPin(1,FALSE);
  for i:=0 to 10000 do;
  SetPin(1,TRUE);
end;

function TVicHW32.GetLPTAckwl : Boolean;
begin
  Result:= not GetPin(10);
end;

function TVicHW32.GetLPTBusy : Boolean;
begin
  Result:= GetPin(11);
end;

function TVicHW32.GetLPTPaperEnd : Boolean;
begin
  Result:= GetPin(12);
end;

function TVicHW32.GetLPTSlct: Boolean;
begin
  Result:=  not GetPin(13);
end;

procedure TVicHW32.LPTAutofd(Flag : Boolean);
begin
  SetPin(14, not Flag);
end;

function TVicHW32.GetLPTError : Boolean;
begin
  Result:=  not GetPin(15);
end;

procedure TVicHW32.LPTInit;
var i : Word;
begin
  SetPin(16,FALSE);
  for i:=1 to 10000 do;
  SetPin(16,TRUE);
end;

procedure TVicHW32.LPTSlctIn;
var data : Byte;
begin
  SetPin(16,FALSE);
  data := fDataPorts[2] and $f7;
  fDataPorts[2] := data;
  SetPortB(fLPTBasePort+2,data);
end;

function TVicHW32.LPTPrintChar(ch : Char) : Boolean;
begin
   Result := FALSE;
   if (fOpenDrive) then
   begin
     SetPortB(fLPTBasePort,Byte(ch));
     if (not GetLPTError) and (not GetLPTBusy) then
     LPTStrobe();
     Result := TRUE;
   end;
end;

function TVicHW32.GetPin(nPin : Byte) : Boolean;
var data,ofs : Byte;
begin
  Result := FALSE;
  if (not fOpenDrive) or (nPin>17) or (nPin<=0) then Exit;
  ofs  := PinsPort[nPin];
  data := GetPortB(fLPTBasePort+ofs);
  Result := (data and MaskPins[nPin]) <> 0;
  if (Negative[nPin]) then Result := not Result;
end;

procedure TVicHW32.SetPin(nPin : Byte; bNewValue : Boolean);
var data,ofs : Byte;
begin
  if (not fOpenDrive) or (nPin>17) or (nPin<=0) then Exit;
  ofs  := PinsPort[nPin];
  data := fDataPorts[ofs];
  if (bNewValue <> Negative[nPin]) then data := data or MaskPins[nPin]
                                   else data := data and (not MaskPins[nPin]);
  SetPortB(fLPTBasePort+ofs,data);
  fDataPorts[ofs] := data;
end;

type TByteArray = array[0..65535] of Byte;
function TVicHW32.GetMemB(MappedAddr : Pointer; Offset : DWORD) : Byte;
begin
  if fOpenDrive then
    Result := TByteArray(MappedAddr^)[Offset]
  else Result:=0;
end;

procedure TVicHW32.SetMemB(MappedAddr : Pointer; Offset : DWORD; nNewValue : Byte);
begin
  if fOpenDrive then
    TByteArray(MappedAddr^)[Offset] := nNewValue
end;

type TWordArray = array[0..65535] of Word;
function TVicHW32.GetMemW(MappedAddr : Pointer; Offset : DWORD) : Word;
begin
  if fOpenDrive then
    Result := TWordArray(MappedAddr^)[Offset]
  else Result:=0;
end;

procedure TVicHW32.SetMemW(MappedAddr : Pointer; Offset : DWORD; nNewValue : Word);
begin
  if fOpenDrive then
    TWordArray(MappedAddr^)[Offset] := nNewValue
end;

type TDWordArray = array[0..65535] of DWORD;
function TVicHW32.GetMemL(MappedAddr : Pointer; Offset : DWORD) : DWORD;
begin
  if fOpenDrive then
    Result := TDWordArray(MappedAddr^)[Offset]
  else Result:=0;
end;

procedure TVicHW32.SetMemL(MappedAddr : Pointer; Offset : DWORD; nNewValue : DWORD);
begin
  if fOpenDrive then
    TDWordArray(MappedAddr^)[Offset] := nNewValue
end;

procedure Register;
begin
  RegisterComponents('Drivers', [TVicHw32]);
end;

end.
上一页 1 23
💿 文件大小 19762 K
👤 上传用户 andyandnancy
📂 所属分类书籍源码
🏷️ 相关标签

#DELPHI #企业级 #方案 #源码
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -