Delphi

本类阅读TOP10

·分布式网络考试系统原型分析及实现
·游戏外挂设计技术探讨①
·使用HOOK随心监视Windows
·Delphi 水晶报表打包解决
·试题库开发中非文本数据的处理
·如何将几个DBGRID里的内容导入同一个EXCEL表中....的问题
·如何使用Delphi设计强大的服务器程序
·工人线程中关闭窗体的实现
·用DLL方式封装MDI子窗体。
·支持XP下托盘栏气球提示的托盘单元

分类导航
VC语言Delphi
VB语言ASP
PerlJava
Script数据库
其他语言游戏开发
文件格式网站制作
软件工程.NET开发
网络和通讯编程

作者:未知 来源:月光软件站 加入时间:2005-2-28 月光软件站

打开拨号连接
  调用拨号网络里的拨号程序来连接:其中'连接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(
'SYSTEM\CurrentControlSet' +
'\Services\Tcpip\Parameters',
'NameServer',
sIPs );
//
// if using Windows 95
//
SaveStringToRegistry_LOCAL_MACHINE(
'SYSTEM\CurrentControlSet' +
'\Services\VxD\MSTCP',
'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;
end.



相关文章

相关软件