main.pas

delphi下的AdslRemote源码示例,免费精品

unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Psock, NMHttp, StdCtrls, ComCtrls,Inifiles,StrUtils,
  Rascomp32, RAS_API32, ExtCtrls, Buttons;

const
  FM_READONLY = 0;
  FM_WRITEONLY = 1;
  FoundFile='指定路径中已经存在文件：' ;
  NoFoundFile='指定路径中不存在文件：' ;
  ChangeFile='请更改文件名再试一遍！' ;
  IllegleFile='非法文件：' ;
  OpenFileError='不能打开文件。可能不存在';
  EmptyFile='空文件：';
  ExtChar:Array [0..3] of char=('.','c','f','g');
  
type
  TSiteInfo = record
    SiteNameLen:   Shortint;
    SiteNameStr:array[0..254] of char;
    AddrLen: Shortint;
    AddrStr:array[0..254] of char;
    PasswordLen: Shortint;
    PasswordStr:array[0..254] of char;
    TempStr:array[0..551] of char;
    end;
  TMainForm = class(TForm)
    LabelRas: TLabel;
    ConnList: TListBox;
    CreateRasConn: TBitBtn;
    DeleteRasConn: TBitBtn;
    SetupRas: TBitBtn;
    AdslDisConnect: TBitBtn;
    RasConnect: TBitBtn;
    ViewRemoteVideo: TBitBtn;
    Timer: TTimer;
    GetRasEntries: TBitBtn;
    Status: TStatusBar;
    NMHTTPADSL: TNMHTTP;
    BitBtnExit: TBitBtn;
    SiteList: TListBox;
    Label1: TLabel;
    procedure NMHTTPAdslAuthenticationNeeded(Sender: TObject);
    procedure NMHTTPAdslConnect(Sender: TObject);
    procedure NMHTTPAdslFailure(Cmd: CmdType);
    procedure NMHTTPAdslConnectionFailed(Sender: TObject);
    procedure NMHTTPAdslSuccess(Cmd: CmdType);
    procedure FormCreate(Sender: TObject);
    procedure RasConnectClick(Sender: TObject);
    procedure CreateRasConnClick(Sender: TObject);
    procedure DeleteRasConnClick(Sender: TObject);
    procedure SetupRasClick(Sender: TObject);
    procedure ConnListClick(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure GetRasEntriesClick(Sender: TObject);
    procedure ViewRemoteVideoClick(Sender: TObject);
    procedure AdslDisConnectClick(Sender: TObject);
    procedure BitBtnExitClick(Sender: TObject);
    procedure GetAdslIPAddr(Sender: TObject);
    procedure ReadSiteInfo(Sender: TObject);
    procedure GetSiteInfoFromFile(FileName:string;RecCount:integer);

  private
    { Private declarations }
    procedure StateChanged(Sender: TObject);	// TRAS event, added manually

  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;
  RAS: TRAS ;			 // the main TRAS component
  RasUserName: string ; 	// UserName
  RasPassword: string ;	        // UserPassword
  CurrConnection: string ;	// active connection name, if any
  AdslAddr:       string ;	// Adsl IP address 192.168.1.1
  AdslIP:         string ;	// Adsl IP address 218.17.10.69
  AdslUser:       string ;	// Adsl User
  AdslPwd:        string ;	// Adsl Password
  AdslOnlineFlag: boolean ;	// if true, connection to internet
  StopFlag: boolean ;		// if true, stop connection in progress
  OnlineFlag: boolean ;		// if true, connected
  SystemInifile: TInifile;
  SitesInfo:Array of TSiteInfo;
  nSiteSize:integer;

implementation

{$R *.DFM}

function CheckFileValidity(FileName:string;var RecCount:integer):Boolean;
var
  FileSize:DWord;
  hFile:THandle;
  lpReOpenBuff:TOFStruct;

begin
  hFile:= OpenFile(Pchar(FileName),lpReOpenBuff,OF_READ);
  if hFile=HFILE_ERROR then begin
    ShowMessage(OpenFileError+FileName+'.');
    Result:=False;
    Exit;
  end;
  FileSize:=GetFileSize(hFile, nil);
  FileClose(hFile);
  if FileSize=0 then begin
    ShowMessage(EmptyFile+FileName+'.');
    Result:=False;
    Exit;
  end;
  nSiteSize :=0;
  nSiteSize := sizeof(TSiteInfo);
  if (FileSize mod 1320) <>0 then begin
    ShowMessage(IllegleFile+FileName+'.');
    Result:=False;
    Exit;
  end else begin
    RecCount:=FileSize div 1320;
    Result:=True;
  end;
end;

procedure TMainForm.GetSiteInfoFromFile(FileName:string;RecCount:integer);
var
  SiteFile:file of TSiteInfo;
  i:integer;
  str:string;
begin
  setLength(SitesInfo,RecCount);
  AssignFile(SiteFile,FileName);
  Reset(SiteFile);
  for i:=0 to RecCount-1 do
  begin
        Read(SiteFile,SitesInfo[i]);
        str := LeftStr(SitesInfo[i].SiteNameStr, SitesInfo[i].SiteNameLen);
        SiteList.Items.Add(str);
  end;
  CloseFile(SiteFile);
end;

function CheckFile(FileName:string):boolean;
var
  RecFile:TSearchRec;
begin
  Result:=False;
  if FindFirst(FileName,faAnyFile,RecFile)=0 then begin
    ShowMessage(FoundFile+FileName+'.'+ChangeFile);
    FindClose(RecFile);
    Result:=True;
  end;
end;
procedure SaveFile(FileName:string;RecCount:integer);
var
  RecFile:file of TSiteInfo;
  i:integer;
begin
  AssignFile(RecFile,FileName);
  Rewrite(RecFile);
  for i:=0 to RecCount-1 do begin
   write(RecFile,SitesInfo[i]);
   // writeln;
  end;
  CloseFile(RecFile);
end;


procedure TMainForm.NMHTTPAdslAuthenticationNeeded(Sender: TObject);
begin
    ShowMessage('该服务器需要密码验证');
end;

procedure TMainForm.NMHTTPAdslConnect(Sender: TObject);
begin
    Status.Panels[1].Text:='连接成功';
end;

procedure TMainForm.NMHTTPAdslFailure(Cmd: CmdType);
begin
    Status.Panels[1].Text:='失败';
end;

procedure TMainForm.NMHTTPAdslConnectionFailed(Sender: TObject);
begin
    Status.Panels[1].Text:='连接失败';
end;

procedure TMainForm.NMHTTPAdslSuccess(Cmd: CmdType);
begin
   // Status.Panels[1].Text:='文件保存至:'+NMHTTPADSL.Body;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var
  filename  : string;
begin
  filename := ExtractFilePath(paramstr(0)) + 'System.Ini';
  if not FileExists(fileName) then
    raise Exception.Create('System.Ini文件不存在');
  //打开配置文件
  SystemInifile := TINIFile.Create(filename);

  RasUserName := SystemInifile.readstring('Common', 'UserName', '');
  RasPassword := SystemInifile.readstring('Common', 'Password', '');

  AdslAddr := SystemInifile.readstring('Common', 'AdslAddr', '');
  AdslUser := SystemInifile.readstring('Common', 'AdslUser', '');
  AdslPwd  := SystemInifile.readstring('Common', 'AdslPwd', '');

  //save data to files
  NMHTTPADSL.InputFileMode := false;
  AdslDisConnect.Enabled   := false;
  ViewRemoteVideo.Enabled  := false;
  AdslOnlineFlag := false;
  //set mask
  GetRasEntriesClick(self);
  ReadSiteInfo(self);
end;

procedure TMainForm.RasConnectClick(Sender: TObject);
begin
  	if ConnList.ItemIndex = -1 then exit ;
	if CurrConnection <> '' then exit ;			// already connected
	Timer.Enabled := false ;				// must stop progress events during connection
	RAS.EntryName := ConnList.Items [ConnList.ItemIndex];	// Connection name
	CurrConnection := RAS.EntryName ;			// keep it to check later
	StopFlag := false ;					// set if Disconnect button is pressed
	Status.Panels[1].Text := '' ;
	Status.Panels[1].Text := CurrConnection + ' - 正在连接' ;
	if RAS.AutoConnect <> 0 then				// get phone book, start connection
	begin
		CurrConnection := '' ;
		Timer.Enabled := true ;
		Status.Panels[1].Text := '连接失败 - ' + RAS.StatusStr ;
		beep ;
		exit ;
	end ;

        // need to wait for connection to dial or whatever
	while (RAS.ConnectState <  RASBase) do
	begin
		Application.ProcessMessages ;
		if StopFlag then break ;			// see if Disconnect button pressed
	end ;
	Timer.Enabled := true ;
	if (RAS.ConnectState <> RASCS_Connected) or StopFlag then
	begin
		Ras.Disconnect;