程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> 網絡和通訊編程

網絡和通訊編程

編輯:Delphi
打開撥號連接
  
  調用撥號網絡裡的撥號程序來連接:其中'連接Internet'為你創建的撥號程序名稱
  winexec('rundll32.exe rnaui.dll,RnaDial '+'連接Internet',9);
  
  一個串口通訊的問題? >
  
  Serial Port Communications?
  問
  I want to build a simple electrical controller which receives input from a
  sensor through a comm port and either turns a power source(s) on or off
  based upon this signal. I want this controller to be software in nature.
  How do I communicate through the port and is it possible to discern changes
  in voltage.
  If not, what kind of signal must be input.
  答
  When you want to write and read only binary signals you can use the printer
  parallel port. For that purpose the Port command is useful. In the below an
  example of some D1 code used for bidirectional 2 wire bus communication (I2C).
  BaseAddress is $278, $378 or $3BC, depending on the LPT port used for
  communication.
  There is a 'but'. In D1 the port function was available but not documented. In
  D2 and D3 it seems to have disappeared entirely (Please somebody correct me if
  this is wrong).
  We are using the parallel printer port with attached a small interface card
  with some I/O buffering for control of RF modules. Could somebody indicate
  whether the Port function still exist or what the alternative could be ?
  regards,
  Hans Brekelmans
  PROCEDURE SetIICline(Terminal: IICterminalTypes; High: Boolean);
  Var Count : Word;
        CtrlAddress: Word;
  Begin { set iic line }
    CtrlAddress:=BaseAddress+2;
    Case Terminal of
      SCL : if High then Port[CtrlAddress]:=$08 else Port[CtrlAddress]:=$00;
      SDA : if NOT High then Port[BaseAddress]:=$80 else Port[BaseAddress]:=$00;
    END;
    For Count := 1 to ClockDelay do;
  End; {SetIICline}
  FUNCTION GetIICline(Terminal: IICterminalTypes): Boolean;
  const SDA_IN=$80; { SDA: 25 pin #11, status, NOT BUSY, bit 7 }
           SCL_IN=$08; { SCL: 25 pin #15, status, NOT Error, bit 3 }
  var Count : Word;
      ReadAddress: Word;
  Begin
     ReadAddress:=BaseAddress+1;
     CASE Terminal OF
       SCL: GetIICline:=((Port[ReadAddress] AND SCL_IN) = SCL_IN);
       SDA: GetIICline:=((Port[ReadAddress] AND SDA_IN) = SDA_IN); { read sda
  pin }
     END;
     For Count := 1 to ClockDelay do;
  End;
  
  得到本機IP地址?
  How about using winsockets?
  This code is untested and ugly.
  program get_ip;
  uses
    winsock,sysutils;
  VAR
    ch : ARRAY[1..32] OF Char;
    i : Integer;
    WSData: TWSAData;
    MyHost: PHostEnt;
  begin
    IF WSAstartup(2,wsdata)<>0 THEN
      BEGIN
        Writeln('can't start Winsock: Error ',WSAGetLastError);
        Halt(2);
      END;
    try
      IF getHostName(@ch[1],32)<>0 THEN
        BEGIN
          Writeln('getHostName failed');
          Halt(3);
        END;
    except
      Writeln('getHostName failed');
      halt(3);
    end;
    MyHost:=GetHostByName(@ch[1]);
    IF MyHost=NIL THEN
      BEGIN
        Writeln(GetHostName('+StrPas(@ch[1])+') failed : Error
  '+IntToStr(WSAGetLastError));
        Halt(4);
      END
    ELSE
      BEGIN
          Write('address ');
           FOR i:=1 TO 4 DO
              BEGIN
                Write(Ord(MyHost.h_addr^[i-1]));
                IF i<4 THEN
                  write('.')
                ELSE
                  writeln;
              END;
     END;
  end.
  
  任何動態改變/添加網絡設置中的 TCP/IP 的 DNS 地址
  
  例如,把 DNS Server的地址添加為192.0.0.1和192.1.1.0,可調用:
  SetTCPIPDNSAddresses('192.0.0.1 192.1.1.0') ;
  // 各地址之間用一個空格隔開
  1. SetTCPIPDNSAddresses 定義如下:
  procedure SetTCPIPDNSAddresses( sIPs : string );
  begin
  //
  // if using Windows NT
  //
  SaveStringToRegistry_LOCAL_MacHINE(
  'SYSTEMCurrentControlSet' +
  'ServicesTcpipParameters',
  'NameServer',
  sIPs );
  //
  // if using Windows 95
  //
  SaveStringToRegistry_LOCAL_MacHINE(
  'SYSTEMCurrentControlSet' +
  'ServicesVxDMSTCP',
  'NameServer',
  sIPs );
  end;
  2. 其中 SaveStringToRegistry_LOCAL_MacHINE 定義:
  uses Registry;
  procedure SaveStringToRegistry_LOCAL_MacHINE(
  sKey, sItem, sVal : string );
  var
  reg : TRegIniFile;
  begin
  reg := TRegIniFile.Create( ' );
  reg.RootKey := HKEY_LOCAL_MacHINE;
  reg.WriteString( sKey, sItem, sVal + #0 );
  reg.Free;
  end;
  如何在程序中動態取得Win95/98的網絡鄰居中的工作組及計算機名?
  可參考下面代碼,或許有所幫助:
  procedure GetDomainList(TV:TTreeVIEw);
  var
  a : Integer;
  ErrCode : Integer;
  NetRes : Array[0..1023] of TNetResource;
  EnumHandle : THandle;
  EnumEntrIEs : DWord;
  BufferSize : DWord;
  s : string;
  itm : TTreeNode;
  begin
  { Start here }
  try
  With NetRes[0] do begin
  dwScope :=RESOURCE_GLOBALNET;
  dwType :=RESOURCETYPE_ANY;
  dwDisplayType :=RESOURCEDISPLAYTYPE_DOMAIN;
  dwUsage :=RESOURCEUSAGE_CONTAINER;
  lpLocalName :=NIL;
  lpRemoteName :=NIL;
  lpComment :=NIL;
  lpProvider :=NIL;
  end;
  { get net root }
  ErrCode:=WNetOpenEnum(
  RESOURCE_GLOBALNET,
  RESOURCETYPE_ANY,
  RESOURCEUSAGE_CONTAINER,
  @NetRes[0],
  EnumHandle
  );
  If ErrCode=NO_ERROR then begin
  EnumEntrIEs:=1;
  BufferSize:=SizeOf(NetRes);
  ErrCode:=WNetEnumResource(
  EnumHandle,
  EnumEntrIEs,
  @NetRes[0],
  BufferSize
  );
  WNetCloseEnum(EnumHandle);
  ErrCode:=WNetOpenEnum(
  RESOURCE_GLOBALNET,
  RESOURCETYPE_ANY,
  RESOURCEUSAGE_CONTAINER,
  @NetRes[0],
  EnumHandle
  );
  EnumEntrIEs:=1024;
  BufferSize:=SizeOf(NetRes);
  ErrCode:=WNetEnumResource(
  EnumHandle,
  EnumEntrIEs,
  @NetRes[0],
  BufferSize
  );
  IF ErrCode=No_Error then with TV do try
  a:=0;
  Items.BeginUpDate;
  Items.Clear;
  Itm:=Items.Add(TV.Selected,string(NetRes[0].lpProvider));
  Itm.ImageIndex:=0;
  Itm.SelectedIndex:=0;
  { get domains }
  下面的一個單元定義了一個組件. TNetworkBrowser, 可以枚舉hIErachical樹上所有
  的網絡資源. 實際上浏覽是要花費很長時間的,這您可以通過在Windows資源管理器
  中打開"整個網絡" 來比較一下. 如果你設置SCOPE屬性 為nsContext , 你就可以看到
  和網絡鄰居中一樣的機器列表.
  unit NetBrwsr;
  interface
  uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
  type
  TNetScope = (nsConnected, nsGlobal, nsRemembered, nsContext);
  TNetResourceType = (nrAny, nrDisk, nrPrint);
  TNetDisplay = (ndDomain, ndGeneric, ndServer, ndShare, ndFile, ndGroup,
  ndNetwork, ndRoot, ndShareAdmin, ndDirectory, ndTree, ndNDSContainer);
  TNetUsage = set of (nuConnectable, nuContainer);
  TNetworkItems = class;
  TNetworkItem = class
  private
  FScope: TNetScope;
  FResourceType: TNetResourceType;
  FDisplay: TNetDisplay;
  FUsage: TNetUsage;
  FLocalName: string;
  FRemoteName: string;
  FComment: string;
  FProvider: string;
  FSubItems: TNetworkItems;
  public
  constructor Create;
  destructor Destroy; override;
  property Scope: TNetScope read FScope;
  property ResourceType: TNetResourceType read FResourceType;
  property Display: TNetDisplay read FDisplay;
  property Usage: TNetUsage read FUsage;
  property LocalName: string read FLocalName;
  property RemoteName: string read FRemoteName;
  property Comment: string read FComment;
  property Provider: string read FProvider;
  property SubItems: TNetworkItems read FSubItems;
  end;
  TNetworkItems = class
  private
  FList: TList;
  procedure SetItem(Index: Integer; Value: TNetworkItem);
  function GetItem(Index: Integer): TNetworkItem;
  function GetCount: Integer;
  public
  constructor Create;
  destructor Destroy; override;
  procedure Clear;
  procedure Add(Item: TNetworkItem);
  procedure Delete(Index: Integer);
  property Items[Index: Integer]: TNetworkItem read GetItem write
  SetItem; default;
  property Count: Integer read GetCount;
  end;
  TNetworkBrowser = class(TComponent)
  private
  FItems: TNetworkItems;
  FScope: TNetScope;
  FResourceType: TNetResourceType;
  FUsage: TNetUsage;
  FActive: Boolean;
  procedure Refresh;
  procedure SetActive(Value: Boolean);
  procedure SetScope(Value: TNetScope);
  procedure SetResourceType(Value: TNetResourceType);
  procedure SetUsage(Value: TNetUsage);
  procedure EnumerateNet(NetItems: TNetworkItems; lpnr: PNetResource);
  protected
  public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
  procedure Open;
  procedure Close;
  property Items: TNetworkItems read FItems;
  published
  property Scope: TNetScope read FScope write SetScope default nsGlobal;
  property ResourceType: TNetResourceType read FResourceType
  write SetResourceType default nrAny;
  property Usage: TNetUsage read FUsage write SetUsage default [];
  property Active: Boolean read FActive write SetActive default False;
  end;
  implementation
  type
  PNetResourceArray = ^TNetResourceArray;
  TNetResourceArray = array[0..0] of TNetResource;
  { TNetworkItem }
  constructor TNetworkItem.Create;
  begin
  inherited;
  FSubItems := TNetworkItems.Create;
  end;
  destructor TNetworkItem.Destroy;
  begin
  if FSubItems <> nil then
  FSubItems.Free;
  inherited;
  end;
  { TNetworkItems }
  constructor TNetworkItems.Create;
  begin
  inherited;
  FList := TList.Create;
  end;
  destructor TNetworkItems.Destroy;
  begin
  Clear;
  if FList <> nil then
  FList.Free;
  inherited;
  end;
  procedure TNetworkItems.SetItem(Index: Integer; Value: TNetworkItem);
  begin
  if (FList.Items[Index] <> nil) and (FList.Items[Index] <> Value) then
  TNetworkItem(FList.Items[Index]).Free;
  FList.Items[Index] := Value;
  end;
  function TNetworkItems.GetItem(Index: Integer): TNetworkItem;
  begin
  Result := TNetworkItem(FList.Items[Index]);
  end;
  procedure TNetworkItems.Clear;
  begin
  while Count > 0 do
  Delete(0);
  end;
  procedure TNetworkItems.Add(Item: TNetworkItem);
  begin
  FList.Add(Item);
  end;
  procedure TNetworkItems.Delete(Index: Integer);
  begin
  if FList.Items[Index] <> nil then
  TNetworkItem(FList.Items[Index]).Free;
  FList.Delete(Index);
  end;
  function TNetworkItems.GetCount: Integer;
  begin
  if FList <> nil then
  Result := FList.Count
  else
  Result := 0;
  end;
  { TNetworkBrowser }
  constructor TNetworkBrowser.Create(AOwner: TComponent);
  begin
  inherited Create(AOwner);
  FItems := TNetworkItems.Create;
  FScope := nsGlobal;
  FResourceType := nrAny;
  FUsage := [];
  end;
  destructor TNetworkBrowser.Destroy;
  begin
  if FItems <> nil then
  FItems.Free;
  inherited;
  end;
  procedure TNetworkBrowser.EnumerateNet(NetItems: TNetworkItems; lpnr:
  PNetResource);
  var
  dwResult, dwResultEnum: Integer;
  hEnum: THandle;
  cbBuffer, cEntrIEs, i: Integer;
  nrArray: PNetResourceArray;
  NewItem: TNetworkItem;
  dwScope, dwType, dwUsage: Integer;
  begin
  cbBuffer := 16384;
  cEntrIEs := $FFFFFFFF;
  case FScope of
  nsConnected: dwScope := RESOURCE_CONNECTED;
  nsGlobal: dwScope := RESOURCE_GLOBALNET;
  nsRemembered: dwScope := RESOURCE_REMEMBERED;
  nsContext: dwScope := RESOURCE_CONTEXT;
  else
  dwScope := RESOURCE_GLOBALNET;
  end;
  case FResourceType of
  nrAny: dwType := RESOURCETYPE_ANY;
  nrDisk: dwType := RESOURCETYPE_DISK;
  nrPrint: dwType := RESOURCETYPE_PRINT;
  else
  dwType := RESOURCETYPE_ANY;
  end;
  dwUsage := 0;
  if nuConnectable in FUsage then
  dwUsage := dwUsage or RESOURCEUSAGE_CONNECTABLE;
  if nuContainer in FUsage then
  dwUsage := dwUsage or RESOURCEUSAGE_CONTAINER;
  dwResult := WNetOpenEnum(dwScope, dwType, dwUsage, lpnr, hEnum);
  if dwResult <> NO_ERROR then Exit;
  GetMem(nrArray, cbBuffer);
  repeat
  dwResultEnum := WNetEnumResource(hEnum, cEntrIEs, nrArray, cbBuffer);
  if dwResultEnum = NO_ERROR then
  for i := 0 to cEntrIEs-1 do
  begin
  NewItem := TNetworkItem.Create;
  case nrArray[i].dwScope of
  RESOURCE_CONNECTED: NewItem.FScope := nsConnected;
  RESOURCE_GLOBALNET: NewItem.FScope := nsGlobal;
  RESOURCE_REMEMBERED: NewItem.FScope := nsRemembered;
  RESOURCE_CONTEXT: NewItem.FScope := nsContext;
  else
  NewItem.FScope := nsGlobal;
  end;
  case nrArray[i].dwType of
  RESOURCETYPE_ANY: NewItem.FResourceType := nrAny;
  RESOURCETYPE_DISK: NewItem.FResourceType := nrDisk;
  RESOURCETYPE_PRINT: NewItem.FResourceType := nrPrint;
  else
  NewItem.FResourceType := nrAny;
  end;
  case nrArray[i].dwDisplayType of
  RESOURCEDISPLAYTYPE_GENERIC: NewItem.FDisplay := ndGeneric;
  RESOURCEDISPLAYTYPE_DOMAIN: NewItem.FDisplay := ndDomain;
  RESOURCEDISPLAYTYPE_SERVER: NewItem.FDisplay := ndServer;
  RESOURCEDISPLAYTYPE_SHARE: NewItem.FDisplay := ndShare;
  RESOURCEDISPLAYTYPE_FILE: NewItem.FDisplay := ndFile;
  RESOURCEDISPLAYTYPE_GROUP: NewItem.FDisplay := ndGroup;
  RESOURCEDISPLAYTYPE_NETWORK: NewItem.FDisplay := ndNetwork;
  RESOURCEDISPLAYTYPE_ROOT: NewItem.FDisplay := ndRoot;
  RESOURCEDISPLAYTYPE_SHAREADMIN: NewItem.FDisplay :=
  ndShareAdmin;
  RESOURCEDISPLAYTYPE_DIRECTORY: NewItem.FDisplay :=
  ndDirectory;
  RESOURCEDISPLAYTYPE_TREE: NewItem.FDisplay := ndTree;
  RESOURCEDISPLAYTYPE_NDSCONTAINER: NewItem.FDisplay :=
  ndNDSContainer;
  else
  NewItem.FDisplay := ndGeneric;
  end;
  NewItem.FUsage := [];
  if nrArray[i].dwUsage and RESOURCEUSAGE_CONNECTABLE <> 0 then
  Include(NewItem.FUsage, nuConnectable);
  if nrArray[i].dwUsage and RESOURCEUSAGE_CONTAINER <> 0 then
  Include(NewItem.FUsage, nuContainer);
  NewItem.FLocalName := StrPas(nrArray[i].lpLocalName);
  NewItem.FRemoteName := StrPas(nrArray[i].lpRemoteName);
  NewItem.FComment := StrPas(nrArray[i].lpComment);
  NewItem.FProvider := StrPas(nrArray[i].lpProvider);
  NetItems.Add(NewItem);
  // if container, call recursively
  if (nuContainer in NewItem.FUsage) and (FScope <> nsContext) then
  EnumerateNet(NewItem.FSubItems, @nrArray[i])
  end;
  until dwResultEnum = ERROR_NO_MORE_ITEMS;
  FreeMem(nrArray);
  WNetCloseEnum(hEnum);
  end;
  procedure TNetworkBrowser.Refresh;
  begin
  FItems.Clear;
  if FActive then
  EnumerateNet(FItems, nil);
  end;
  procedure TNetworkBrowser.SetActive(Value: Boolean);
  begin
  if Value <> FActive then
  begin
  FActive := Value;
  Refresh;
  end;
  end;
  procedure TNetworkBrowser.SetScope(Value: TNetScope);
  begin
  if Value <> FScope then
  begin
  FScope := Value;
  Refresh;
  end;
  end;
  procedure TNetworkBrowser.SetResourceType(Value: TNetResourceType);
  begin
  if Value <> FResourceType then
  begin
  FResourceType := Value;
  Refresh;
  end;
  end;
  procedure TNetworkBrowser.SetUsage(Value: TNetUsage);
  begin
  if Value <> FUsage then
  begin
  FUsage := Value;
  Refresh;
  end;
  end;
  procedure TNetworkBrowser.Open;
  begin
  Active := True;
  end;
  procedure TNetworkBrowser.Close;
  begin
  Active := False;
  end;
  
  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved