main.pas

ADSL计时器

//=========================================================================//
//                                                                         //
//                              主窗口源代码                               //
//                               作者:沈杰                                 //
//                               2003-03-21                                //
//                实现了ADSL上网监视计时,可以实现最基本的用户需求          //
//                    希望大家不要删除本程序中这样的注释语句               //
//=========================================================================//

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Menus, wininet, WinSock, XPMenu,
  ADSLStringRes, INIFiles, ImgList, SetupFrm, DateUtils, RzTray, Registry,
  ShellAPI;

type
  OSType = (osUnknown, osWin95, osWin98, osWin98se, osWinme, osWinnt4, osWin2k,
    osWinxp);

type
  TFrmADSLMain = class(TForm)
    MainMenu1: TMainMenu;
    Panel1: TPanel;
    MenuSetup: TMenuItem;
    MenuView: TMenuItem;
    MenuDropFrm: TMenuItem;
    MenuFrmTrans: TMenuItem;
    DateTimePicker1: TDateTimePicker;
    PanDate: TPanel;
    PanDateSelect: TPanel;
    TreeView1: TTreeView;
    StatusBar1: TStatusBar;
    panMain: TPanel;
    ListView1: TListView;
    Splitter1: TSplitter;
    Splitter2: TSplitter;
    Memo1: TMemo;
    XPMenu1: TXPMenu;
    ilstTree: TImageList;
    tmrChecker: TTimer;
    tmrTime: TTimer;
    lblMonthStr: TLabel;
    lblCurStr: TLabel;
    lblStartStr: TLabel;
    RzTrayIcon1: TRzTrayIcon;
    pMenuMain: TPopupMenu;
    MenuShowDrop: TMenuItem;
    MenuShowMain: TMenuItem;
    MenuDropTran: TMenuItem;
    MenuN1: TMenuItem;
    MenuN2: TMenuItem;
    MenuClose: TMenuItem;
    MenuHelp: TMenuItem;
    MenuHelpTopic: TMenuItem;
    MenuAbout: TMenuItem;
    MenuN3: TMenuItem;
    MMenuDropSetup: TMenuItem;
    N1: TMenuItem;
    E1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure MenuDropFrmClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure MenuFrmTransClick(Sender: TObject);
    procedure MenuOptionClick(Sender: TObject);
    procedure tmrCheckerTimer(Sender: TObject);
    procedure tmrTimeTimer(Sender: TObject);
    procedure MenuCloseClick(Sender: TObject);
    procedure MenuShowMainClick(Sender: TObject);
    procedure MenuAboutClick(Sender: TObject);
    procedure MMenuDropSetupClick(Sender: TObject);
    procedure E1Click(Sender: TObject);
    procedure MenuHelpTopicClick(Sender: TObject);
  private
    { Private declarations }
    XSTimeMonth, XSTimeDay, JSDay: Byte; //每天限时的时间

    MonthDate: string; //本月用时,这个应该是一个累加的字符串变量，因为
    //Delphi里面的时间变量的小时数无法超过24.只能用字符串来代替
    CurrentDate, EndTime: TTime;

    MonthStart: TDateTime; //本月开始的时间和日期

    szCallSound: string; //报警声音的路径
    IsCallSound: Boolean; //是否报警
    IsDefaultSound: Boolean; //是否使用默认声音报警
    IsSetupDay: Boolean; //每个月重新计时那天是否已经重新计时
  public
    { Public declarations }
    procedure ShowDropFrm;
    procedure InitDateProc; //这个过程中还初始化了程序所在的目录地址
    procedure AddNameToTreeNode; //添加用户名到树型节点
    procedure AddIPToListView;
    procedure WriteTimeToFile(FileName: string; SumTime: string);
    procedure ReadFileToListView(FileName: string = '');
    procedure WM_MyAppendMenu(var msg: TWMSysCommand); message WM_SYSCOMMAND;
    function CheckOffline: boolean;
    function CountStrToDateTime(const str: string; DateTime: TDateTime): string;
  end;

var
  FrmADSLMain: TFrmADSLMain;
  hnd: THandle;

implementation

uses
  DropFrm, AboutFrm, DropSetupFrm, MMSystem;
{$R *.dfm}

function GetOSVersion: OSType;
var
  osVerInfo: TOSVersionInfo;
  majorVer, minorVer: Integer;
begin
  osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  if (GetVersionEx(osVerInfo)) then
  begin
    majorVer := osVerInfo.dwMajorVersion;
    minorVer := osVerInfo.dwMinorVersion;
    case (osVerInfo.dwPlatformId) of
      VER_PLATFORM_WIN32_NT: { Windows NT/2000 }
        begin
          if (majorVer <= 4) then
            Result := osWinnt4
          else if ((majorVer = 5) and (minorVer = 0)) then
            Result := osWin2k
          else if ((majorVer = 5) and (minorVer = 1)) then
            Result := osWinxp
          else
            Result := OsUnknown;
        end;
      VER_PLATFORM_WIN32_WINDOWS: { Windows 9x/ME }
        begin
          if ((majorVer = 4) and (minorVer = 0)) then
            Result := osWin95
          else if ((majorVer = 4) and (minorVer = 10)) then
          begin
            if (osVerInfo.szCSDVersion[1] = 'A') then
              Result := osWin98se
            else
              Result := osWin98;
          end
          else if ((majorVer = 4) and (minorVer = 90)) then
            Result := OsWinME
          else
            Result := OsUnknown;
        end;
    else
      Result := OsUnknown;
    end; //end of case
  end
  else
    Result := OsUnknown;
end;

//获得本机IP地址(静态分配的IP)

function LocalIP: string;
type
  TaPInAddr = array[0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe: PHostEnt;
  pptr: PaPInAddr;
  Buffer: array[0..63] of char;
  I: Integer;
  GInitData: TWSADATA;
begin
  WSAStartup($101, GInitData);
  GetHostName(Buffer, SizeOf(Buffer));
  phe := GetHostByName(buffer);
  if phe = nil then
    Exit;
  pptr := PaPInAddr(Phe^.h_addr_list);
  I := 0;
  result := StrPas(inet_ntoa(pptr^[i]^));
  WSACleanup;
end;

function HostName: string;
var
  Buffer: array[0..127] of char;
  GInitData: TWSADATA;
begin
  WSAStartup($101, GInitData);
  result := '';
  GetHostName(Buffer, Sizeof(Buffer));
  result := StrPas(Buffer);
  WSACleanup;
end;

procedure TFrmADSLMain.InitDateProc;
var
  INI: TINIFile;
  Reg: TRegistry;
begin
  Path := ExtractFilePath(ParamStr(0));

  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run', False) then
      if Reg.ReadString('ADSL') = '' then
        Reg.WriteString('ADSL', Application.ExeName);
  finally
    FreeAndNil(Reg);
  end;

  INI := TINIFile.Create(Path + 'ADSL.ini');
  try
      IsSetupDay := INI.ReadBool('Setup', 'SetupBool', False);
      XSTimeMonth := StrToInt(INI.ReadString('Setup', 'MonthDate', '120'));
      //每月的限时小时
      XSTimeDay := StrToInt(INI.ReadString('Setup', 'Date', '5'));
      //每天的限时小时
      JSDay := StrToInt(INI.ReadString('Setup', 'Start', '21')); //计时开始日期

      //是否使用声音报警
      IsCallSound := INI.ReadBool('Setup', 'Sound', False);
      IsDefaultSound := INI.ReadBool('Setup', 'DefaultSound', True);

      if (JSDay = DayOf(Now)) and (IsSetupDay = False) then
        //如果到了每个月的计时日期
      begin
        MonthDate := '00:00:00';
        INI.WriteBool('Setup', 'SetupBool', IsSetupDay);
      end
      else
      begin
        MonthDate := INI.ReadString('Date', 'SumTime', '00:00:00');
        INI.WriteBool('Setup', 'SetupBool', IsSetupDay);
      end;

      MonthStart := INI.ReadDateTime('Date', 'Start', Now);

      szCallSound := INI.ReadString('Setup', 'SoundPath', '');
  finally
    INI.Free;
  end;
  ReadFileToListView(Path + 'ADSL.trv');
  DateTimePicker1.Date := Now;
  AddNameToTreeNode;
  AddIPToListView;
end;

procedure TFrmADSLMain.FormCreate(Sender: TObject);
begin
  InitDateProc;

  lblMonthStr.Caption := Str1 + MonthDate;
  lblCurStr.Caption := Str2 + FormatDateTime('hh:mm:ss', CurrentDate);
  lblStartStr.Caption := Str3 + DateTimeToStr(MonthStart);
  case GetOSVersion of //
    osUnknown..osWinme:
      begin
        MenuFrmTrans.Enabled := False;
        MenuFrmTrans.Checked := False;
      end;
  end; // case
end;

procedure TFrmADSLMain.ShowDropFrm;
begin
  if FrmDrop.Showing = False then
  begin
    if MenuDropFrm.Checked then
    begin
      FrmDrop := TFrmDrop.Create(Self);
      FrmDrop.Visible := True;
      FrmADSLMain.Visible := True;
    end;
    if MenuFrmTrans.Checked then
    begin
      FrmDrop.AlphaBlend := True;
      FrmDrop.AlphaBlendValue := 150;
    end;
  end;
  FrmDrop.Label1.Caption := MonthDate;
  ListView1.SetFocus;
end;

procedure TFrmADSLMain.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  FreeAndNil(tmrChecker);
  FreeAndNil(tmrTime);
  EndTime := CurrentDate;
  //断网的时候并且需要给MonthDate字符串赋值新的时间
  MonthDate := CountStrToDateTime(MonthDate, EndTime);
  if (CurrentDate <> 0) or (EndTime <> 0) then
  begin
    MonthDate := CountStrToDateTime(MonthDate, EndTime);
    WriteTimeToFile(Path + 'ADSL.ini', MonthDate);
  end;

  SendMessage(FrmDrop.Handle, WM_CLOSE, 0, 0);
end;

procedure TFrmADSLMain.MenuDropFrmClick(Sender: TObject);
begin
  MenuDropFrm.Checked := not MenuDropFrm.Checked;
  MenuShowDrop.Checked := not MenuShowDrop.Checked;
  if MenuDropFrm.Checked then
  begin
    FrmDrop.Visible := True;
    FrmDrop.pelMain.Visible := True;
  end
  else
  begin
    FrmDrop.Hide;
  end;
end;

procedure TFrmADSLMain.FormShow(Sender: TObject);
begin
  ShowDropFrm;
end;

procedure TFrmADSLMain.MenuFrmTransClick(Sender: TObject);
begin
  MenuFrmTrans.Checked := not MenuFrmTrans.Checked;
  MenuDropTran.Checked := not MenuDropTran.Checked;
  if MenuFrmTrans.Checked then
  begin
    FrmDrop.AlphaBlend := True;
    FrmDrop.AlphaBlendValue := 150;
  end
  else
    FrmDrop.AlphaBlend := False;
end;