Порты

Code:

function PortExists(const PortName: string): Boolean;

var

hPort: HWND;

begin

Result := False;

hPort := CreateFile(PChar(PortName), {name}

   GENERIC_READ or GENERIC_WRITE, {access attributes}

   0, {no sharing}

   nil, {no security}

   OPEN_EXISTING, {creation action}

   FILE_ATTRIBUTE_NORMAL or

   FILE_FLAG_OVERLAPPED, {attributes}

   0); {no template}

if hPort <> INVALID_HANDLE_VALUE then

begin

   CloseHandle(hPort);

   Result := True;

end;

end;

{Parallel Ports}

for i := 1 to 9 do

begin

if PortExists('LPT' + IntToStr(i)) then

   List.Append('Ports: Printer Port (LPT' + IntTostr(i) + ')');

end;

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

CommPort : string;

hCommFile : THandle;

Buffer : PCommConfig;

size : DWORD;

begin

CommPort := 'COM1';

{Открываем Com-порт}

hCommFile := CreateFile(PChar(CommPort),

                         GENERIC_WRITE,

                         0,

                         nil,

                         OPEN_EXISTING,

                         FILE_ATTRIBUTE_NORMAL,

                         0);

if hCommFile=INVALID_HANDLE_VALUE then

begin

   ShowMessage('Unable to open '+ CommPort);

   exit;

end;

{Выделяем временный буфер}

GetMem(Buffer, sizeof(TCommConfig));

{Получаем размер структуры CommConfig}

size := 0;

GetCommConfig(hCommFile, Buffer^, size);

{Освобождаем временный буфер}

FreeMem(Buffer, sizeof(TCommConfig));

{Выделяем память для структуры CommConfig}

GetMem(Buffer, size);

GetCommConfig(hCommFile, Buffer^, size);

{Изменяем скорость передачи}

Buffer^.dcb.BaudRate := 1200;

{Устанавливаем новую конфигурацию для COM-порта}

SetCommConfig(hCommFile, Buffer^, size);

{Освобождаем буфер}

FreeMem(Buffer, size);

{Закрываем COM-порт}

CloseHandle(hCommFile);

end;

Code:

value:=port[$379]; \{ Прочитать из порта \}

port[$379]:=value; \{ Записать в порт \}

Code:

function GetPortAddress(PortNo: integer): word; assembler; stdcall;

asm

push es

push ebx

mov ebx, PortNo

shl ebx,1

mov ax,40h // Dos segment adress

mov es,ax

mov ax,ES:[ebx+6] // get port adress in 16Bit way :)

pop ebx

pop es

end;

Code:

unit U_Usb;

interface

uses

Windows, Messages, SysUtils, Classes, Forms;

type

PDevBroadcastHdr  = ^DEV_BROADCAST_HDR;

DEV_BROADCAST_HDR = packed record

   dbch_size: DWORD;

   dbch_devicetype: DWORD;

   dbch_reserved: DWORD;

end;

PDevBroadcastDeviceInterface  = ^DEV_BROADCAST_DEVICEINTERFACE;

DEV_BROADCAST_DEVICEINTERFACE = record

   dbcc_size: DWORD;

   dbcc_devicetype: DWORD;

   dbcc_reserved: DWORD;

   dbcc_classguid: TGUID;

   dbcc_name: short;

end;

const

GUID_DEVINTERFACE_USB_DEVICE: TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';

DBT_DEVICEARRIVAL          = $8000;          // system detected a new device

DBT_DEVICEREMOVECOMPLETE   = $8004;          // device is gone

DBT_DEVTYP_DEVICEINTERFACE = $00000005;      // device interface class

type

TComponentUSB = class(TComponent)

private

   FWindowHandle: HWND;

   FOnUSBArrival: TNotifyEvent;

   FOnUSBRemove: TNotifyEvent;

   procedure WndProc(var Msg: TMessage);

   function USBRegister: Boolean;

protected

   procedure WMDeviceChange(var Msg: TMessage); dynamic;

public

   constructor Create(AOwner: TComponent); override;

   destructor Destroy; override;

published

   property OnUSBArrival: TNotifyEvent read FOnUSBArrival write FOnUSBArrival;

   property OnUSBRemove: TNotifyEvent read FOnUSBRemove write FOnUSBRemove;

end;

implementation

constructor TComponentUSB.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

FWindowHandle := AllocateHWnd(WndProc);

USBRegister;

end;

destructor TComponentUSB.Destroy;

begin

DeallocateHWnd(FWindowHandle);

inherited Destroy;

end;

procedure TComponentUSB.WndProc(var Msg: TMessage);

begin

if (Msg.Msg = WM_DEVICECHANGE) then

begin

   try

     WMDeviceChange(Msg);

   except

     Application.HandleException(Self);

   end;

end

else

   Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);

end;

procedure TComponentUSB.WMDeviceChange(var Msg: TMessage);

var

devType: Integer;

Datos: PDevBroadcastHdr;

begin

if (Msg.wParam = DBT_DEVICEARRIVAL) or (Msg.wParam = DBT_DEVICEREMOVECOMPLETE) then

begin

   Datos := PDevBroadcastHdr(Msg.lParam);

   devType := Datos^.dbch_devicetype;

   if devType = DBT_DEVTYP_DEVICEINTERFACE then

   begin // USB Device

     if Msg.wParam = DBT_DEVICEARRIVAL then

     begin

       if Assigned(FOnUSBArrival) then

         FOnUSBArrival(Self);

     end

     else

     begin

       if Assigned(FOnUSBRemove) then

         FOnUSBRemove(Self);

     end;

   end;

end;

end;

function TComponentUSB.USBRegister: Boolean;

var

dbi: DEV_BROADCAST_DEVICEINTERFACE;

Size: Integer;

r: Pointer;

begin

Result := False;

Size := SizeOf(DEV_BROADCAST_DEVICEINTERFACE);

ZeroMemory(@dbi, Size);

dbi.dbcc_size := Size;

dbi.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACE;

dbi.dbcc_reserved := 0;

dbi.dbcc_classguid  := GUID_DEVINTERFACE_USB_DEVICE;

dbi.dbcc_name := 0;

r := RegisterDeviceNotification(FWindowHandle, @dbi,

   DEVICE_NOTIFY_WINDOW_HANDLE

   );

if Assigned(r) then Result := True;

end;

end.

Code:

uses Registry;

procedure TForm1.Button1Click(Sender: TObject);

var

reg : TRegistry;

ts : TStrings;

i : integer;

begin

reg := TRegistry.Create;

reg.RootKey := HKEY_LOCAL_MACHINE;

reg.OpenKey('hardware\devicemap\serialcomm',

             false);

ts := TStringList.Create;

reg.GetValueNames(ts);

for i := 0 to ts.Count -1 do begin

   Memo1.Lines.Add(reg.ReadString(ts.Strings[i]));

end;

ts.Free;

reg.CloseKey;

reg.free;

end;