udnsclient.pas

NSinspector是一个Intenet地址解析工具(类似NSLookUp)(156KB)

UNIT UDNSClient;

INTERFACE

USES
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  WSockets, WinSock, StdCtrls, ComCtrls, ExtCtrls, Menus, Registry;

CONST

  NSListFile = 'nservers.txt';

  QueryID    : WORD = 0;   // Queryversion

  MaxTimeOut : WORD = 20;  // 20 Sec
  PosDiff    = 12;         // Bufferoffset

  DNSPort    = '53';

  Header_Option   : STRING[10] = #1#0#0#1#0#0#0#0#0#0; //  Headersection without VersionID

  QClass_Internet = #0#1;

  QType_A     = 1;
  QType_NS    = 2;
  QType_CNAME = 5;
  QType_SOA   = 6;
  QType_PTR   = 12;
  QType_MX    = 15;
  QType_ALL   = 255;

  QType_A_Str     = 'A';
  QType_NS_Str    = 'NS';
  QType_CNAME_Str = 'CNAME';
  QType_SOA_Str   = 'SOA';
  QType_PTR_Str   = 'PTR';
  QType_MX_Str    = 'MX';
  QType_ALL_Str   = 'ALL';


TYPE

  TLabelStr = STRING[255];

  TuLong    = RECORD
    CASE INTEGER OF
      0 : (
            Value : CARDINAL;
          );
      1 : (
            B : ARRAY[0..3] OF BYTE;
          );
  END;

  TuShort   = RECORD
    CASE INTEGER OF
      0 : (
            Value : WORD;
          );
      1 : (
            B : ARRAY[0..1] OF BYTE;
          );
  END;

  TBufferRec = RECORD
    Count   : WORD;
    ID      : WORD;
    CASE INTEGER OF
     0 : (
           Option  : ARRAY[0..1] OF CHAR;
           QDCount : ARRAY[0..1] OF CHAR;
           ANCount : ARRAY[0..1] OF CHAR;
           NSCount : ARRAY[0..1] OF CHAR;
           ARCount : ARRAY[0..1] OF CHAR;
           Data    : ARRAY[0..511] OF CHAR;
         );
     1 : (
           nOption  : WORD;
           nQDCount : WORD;
           nANCount : WORD;
           nNSCount : WORD;
           nARCount : WORD;
           nData    : ARRAY[0..511] OF BYTE;
         )
  END;

  TfrmMain = CLASS(TForm)
    edData: TEdit;
    btnQuery: TButton;
    StatusBar1: TStatusBar;
    cbType: TComboBox;
    memoLog: TMemo;
    Panel1: TPanel;
    Label1: TLabel;
    Label3: TLabel;
    cbHost: TComboBox;
    Label2: TLabel;
    mnuMain: TMainMenu;
    mnuFile: TMenuItem;
    mnuPreferences: TMenuItem;
    mnuAbout: TMenuItem;
    mnuClose: TMenuItem;
    mnuSep1: TMenuItem;
    mnuSaveLog: TMenuItem;
    dlgSaveLog: TSaveDialog;
    PROCEDURE edChange(Sender: TObject);
    PROCEDURE FormCreate(Sender: TObject);
    PROCEDURE FormDestroy(Sender: TObject);
    PROCEDURE btnQueryClick(Sender: TObject);
    procedure mnuAboutClick(Sender: TObject);
    procedure mnuCloseClick(Sender: TObject);
    procedure mnuSaveLogClick(Sender: TObject);
    procedure mnuPreferencesClick(Sender: TObject);
  PRIVATE
    UDPClient : TUDPClient;
    Buffer    : TBufferRec;
    TimeOut   : TTimer;
    Waiting   : BOOLEAN;

    PROCEDURE OnTimeOut(Sender: TObject);

    PROCEDURE UDPClientError(Sender: TObject; Error: integer; Msg: STRING);
    PROCEDURE UDPClientData(Sender: TObject; Socket: TSocket);
    PROCEDURE StringToLabel(Str : STRING; VAR Buf : TLabelStr);
    PROCEDURE LabelToString(Buf : POINTER; VAR Pos : WORD; VAR Str : String);
    FUNCTION  GetQType(qt : STRING): STRING;
  PUBLIC
    PROCEDURE TTY(Msg: STRING);
  END;

VAR
  frmMain: TfrmMain;


{--------------------------------------------------------}
IMPLEMENTATION

USES UAbout, UPreferences;

{$R *.DFM}

PROCEDURE TfrmMain.FormCreate(Sender: TObject);
VAR Reg : TRegistry;
BEGIN
  UDPClient := TUDPClient.Create(Self);
  WITH UDPClient DO BEGIN
    OnError := UDPClientError;
    OnData := UDPClientData;
  END;
  cbHost.Items.LoadFromFile(ExtractFileDir(Application.ExeName)+'\'+NSListFile);
  IF cbHost.Items.Count > 0 THEN cbHost.Text := cbHost.Items[0];
  {-}
  Reg := TRegistry.Create;
  TRY
    Reg.RootKey := HKey_Local_Machine;
    Reg.OpenKey('\SOFTWARE\NSinspector',TRUE);
    {-}
    IF NOT Reg.ValueExists('BackgroundColor') THEN Reg.WriteInteger('BackgroundColor',memoLog.Color);
    IF NOT Reg.ValueExists('Font') THEN Reg.WriteString('Font',memoLog.Font.Name);
    IF NOT Reg.ValueExists('FontColor') THEN Reg.WriteInteger('FontColor',memoLog.Font.Color);
    IF NOT Reg.ValueExists('FontSize') THEN Reg.WriteInteger('FontSize',memoLog.Font.Size);
    IF NOT Reg.ValueExists('FontStyleBold') THEN
      IF fsBold IN memoLog.Font.Style THEN Reg.WriteBool('FontStyleBold',TRUE)
                                      ELSE Reg.WriteBool('FontStyleBold',FALSE);
    IF NOT Reg.ValueExists('FontStyleItalic') THEN
      IF fsItalic IN memoLog.Font.Style THEN Reg.WriteBool('FontStyleItalic',TRUE)
                                        ELSE Reg.WriteBool('FontStyleItalic',FALSE);
    IF NOT Reg.ValueExists('FontStyleUnderline') THEN
      IF fsUnderline IN memoLog.Font.Style THEN Reg.WriteBool('FontStyleUnderline',TRUE)
                                           ELSE Reg.WriteBool('FontStyleUnderline',FALSE);
    IF NOT Reg.ValueExists('FontStyleStrikeout') THEN
      IF fsStrikeout IN memoLog.Font.Style THEN Reg.WriteBool('FontStyleStrikeout',TRUE)
                                           ELSE Reg.WriteBool('FontStyleStrikeout',FALSE);
    IF NOT Reg.ValueExists('Timeout') THEN Reg.WriteInteger('Timeout',MaxTimeOut);

    memoLog.Color      := Reg.ReadInteger('BackgroundColor');
    memoLog.Font.Name  := Reg.ReadString('Font');
    memoLog.Font.Color := Reg.ReadInteger('FontColor');
    memoLog.Font.Size  := Reg.ReadInteger('FontSize');
    memoLog.Font.Style := [];
    IF Reg.ReadBool('FontStyleBold') THEN memoLog.Font.Style := memoLog.Font.Style+[fsBold];
    IF Reg.ReadBool('FontStyleItalic') THEN memoLog.Font.Style := memoLog.Font.Style+[fsItalic];
    IF Reg.ReadBool('FontStyleUnderline') THEN memoLog.Font.Style := memoLog.Font.Style+[fsUnderline];
    IF Reg.ReadBool('FontStyleStrikeout') THEN memoLog.Font.Style := memoLog.Font.Style+[fsStrikeout];

    MaxTimeOut := Reg.ReadInteger('Timeout');

  FINALLY
    Reg.Free;
  END;
END;

PROCEDURE TfrmMain.FormDestroy(Sender: TObject);
VAR Reg : TRegistry;
BEGIN
  UDPClient.Free;
  cbHost.Items.SaveToFile(NSListFile);
  {-}
  Reg := TRegistry.Create;
  TRY
    Reg.RootKey := HKey_Local_Machine;
    Reg.OpenKey('\SOFTWARE\NSinspector',TRUE);
    {-}
    Reg.WriteInteger('BackgroundColor',memoLog.Color);
    Reg.WriteString('Font',memoLog.Font.Name);
    Reg.WriteInteger('FontColor',memoLog.Font.Color);
    Reg.WriteInteger('FontSize',memoLog.Font.Size);
    IF fsBold IN memoLog.Font.Style THEN Reg.WriteBool('FontStyleBold',TRUE)
                                    ELSE Reg.WriteBool('FontStyleBold',FALSE);
    IF fsItalic IN memoLog.Font.Style THEN Reg.WriteBool('FontStyleItalic',TRUE)
                                      ELSE Reg.WriteBool('FontStyleItalic',FALSE);
    IF fsUnderline IN memoLog.Font.Style THEN Reg.WriteBool('FontStyleUnderline',TRUE)
                                         ELSE Reg.WriteBool('FontStyleUnderline',FALSE);
    IF fsStrikeout IN memoLog.Font.Style THEN Reg.WriteBool('FontStyleStrikeout',TRUE)
                                         ELSE Reg.WriteBool('FontStyleStrikeout',FALSE);
    Reg.WriteInteger('Timeout',MaxTimeOut);
  FINALLY
    Reg.Free;
  END;
END;

PROCEDURE TfrmMain.mnuCloseClick(Sender: TObject);
BEGIN
  Application.Terminate;
END;

PROCEDURE TfrmMain.mnuAboutClick(Sender: TObject);
BEGIN
  frmAbout.ShowModal;
END;

PROCEDURE TfrmMain.mnuSaveLogClick(Sender: TObject);
BEGIN
  IF dlgSaveLog.Execute THEN memoLog.Lines.SaveToFile(dlgSaveLog.FileName);
END;

PROCEDURE TfrmMain.mnuPreferencesClick(Sender: TObject);
BEGIN
  frmPreferences.ShowModal;
END;

{-------------------------------------}

PROCEDURE TfrmMain.TTY(Msg: STRING);
BEGIN
  WITH memoLog.Lines DO BEGIN
    IF Count > 100 THEN
      Delete(0);
    Add(Msg);
  END;
END;

PROCEDURE TfrmMain.edChange(Sender: TObject);
BEGIN
  btnQuery.Enabled := (cbHost.Text <> '') AND (edData.Text <> '');
END;

PROCEDURE TfrmMain.UDPClientError(Sender: TObject; Error: INTEGER; Msg: STRING);
BEGIN
  MessageDlg(Msg, mtError, [mbOK], 0);
END;

PROCEDURE TfrmMain.OnTimeOut(Sender: TObject);