⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 Demo Name: Main Author: Ted Rybicki Purpose: Sync up systems and workstations clock through
💻 PAS
字号:
unit Main;
{-----------------------------------------------------------------------------
 Demo Name: Main
 Author:    Ted Rybicki
 Purpose:   Sync up systems and workstations clock through firewalls with socks
            support. NOTE: You will need to set Name field in IdSocksInfo1 to
            your socks server for socks support to work correctly.
 History:
 Date:      27/10/2002 01:49:13
 Checked with Indy version: 9.0
 ----------------------------------------------------------------------------
 Notes:

 Demonstrates a DateTime client getting current date and time from remote DateTimeServer

 A list of time servers is available at:
 http://www.eecis.udel.edu/~mills/ntp/servers.html
}
interface

uses
  Windows, Messages, Graphics, Controls, Forms, Dialogs, StdCtrls,
  SysUtils, Classes, IdComponent, IdTCPConnection, IdTCPClient, IdTime,
  IdBaseComponent, IdSocks, IdIOHandler, IdIOHandlerSocket;

const
  TIME_ZONE_ID_UNKNOWN  = 0;
  TIME_ZONE_ID_STANDARD = 1;
  TIME_ZONE_ID_DAYLIGHT = 2;

type

  TfrmTimeDemo = class(TForm)
    lblTimeServer: TLabel;
    IdDemoTime: TIdTime;
    edtTimeResult: TEdit;
    Label1: TLabel;
    btnGetTime: TButton;
    cmboTimeServer: TComboBox;
    IdIOHandlerSocket1: TIdIOHandlerSocket;
    IdSocksInfo1: TIdSocksInfo;
    Label2: TLabel;
    CheckBox1: TCheckBox;
    procedure btnGetTimeClick(Sender: TObject);
  private
    Ftz: TTimeZoneInformation;
    function GetTimeZoneBias: Integer;
    function GetTimeZoneInfo: DWord;
    function DayLightSavingTime(aTime: TDateTime) : boolean;
  public
  end;

var
  frmTimeDemo: TfrmTimeDemo;

implementation
{$R *.DFM}

uses HTTPApp, procs; // DayOfWeekStr & MonthStr

function TfrmTimeDemo.GetTimeZoneBias: Integer;
begin
  case GetTimeZoneInformation(Ftz) of
    TIME_ZONE_ID_STANDARD: Result := -(Ftz.StandardBias + Ftz.Bias) div (24*60);
    TIME_ZONE_ID_DAYLIGHT: Result := -(Ftz.DaylightBias + Ftz.Bias) div (24*60);
  else
    Result := 0;
  end;
end;

function TfrmTimeDemo.GetTimeZoneInfo: DWord;
begin

  result := GetTimeZoneInformation(Ftz);

  case GetTimeZoneInformation(Ftz) of
    TIME_ZONE_ID_STANDARD: ShowMessage(Ftz.StandardName);
    TIME_ZONE_ID_DAYLIGHT: ShowMessage(Ftz.DaylightName);
  else
    ShowMessage('Unknown state');
  end;
end;

function TfrmTimeDemo.DayLightSavingTime(aTime: TDateTime): boolean;
var
  sMonth,
  sDay    : string;
begin
  { TODO -oTedr -cMust do : Must creat the routing to get this working }
  sDay   := DayOfWeekStr(aTime); //'Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat'
  sMonth := MonthStr(aTime); //'Jan', 'Feb', 'Mar', 'Apr','May', 'Jun', 'Jul', 'Aug','Sep', 'Oct', 'Nov', 'Dec'

  if (sMonth = 'Nov') or (sMonth = 'Dec') or (sMonth = 'Jan') or (sMonth = 'Feb') or (sMonth = 'Mar') then
    result := false // we know we are Standard Time in these months
  else
   if (sMonth = 'May') or (sMonth = 'Jun') or (sMonth = 'Jul') or (sMonth = 'Aug') or (sMonth = 'Sep') then
    result := true  // we know we are Daylight Saving Time
   else
    if (sMonth = 'Arp') then // check to see if we are past or before the first Sunday
     result := true //todo !
    else
     if (sMonth = 'Oct') then // check to see if we are past or before the last Sunday
      result := false; //todo !

  result := true; //todo!!!tbr! broken

  //if (sDay = 'Apr') and (sMonth = '
  //Daylight Saving Time begins for most of the United States at 2 a.m. on the first Sunday of April.

  //Time reverts to standard time at 2 a.m. on the last Sunday of October. In the U.S., each time zone
  //switches at a different time.

  //In the European Union, Summer Time begins and ends at 1 am Universal Time (Greenwich Mean Time).
  //It starts the last Sunday in March, and ends the last Sunday in October. In the EU, all time zones
  //change at the same moment.
end;


// No real code required - all functionality built into component !
procedure TfrmTimeDemo.btnGetTimeClick(Sender: TObject);
var
  NewTime:        TSystemTime;

  NewTDateTime,
  FStartDateTime,
  FRealTime,
  FDiffTime:      TdateTime;

  SysTimeZone:    DWord;
  SysTimeBias:    integer;
begin
  FStartDateTime     := now;
  SysTimeZone        := GetTimeZoneInfo;
  SysTimeBias        := GetTimeZoneBias;
  edtTimeResult.Text := IntToStr(SysTimeBias);

  //DayLightSavingTime(FStartDateTime);


  if CheckBox1.Checked then
   IdSocksInfo1.Version := svSocks5
  else
   IdSocksInfo1.Version := svNoSocks;

  IdDemoTime.Host := cmboTimeServer.Text; // Set the host address

  { After setting Host, this is all you have to get the time from a time
  server.  We do the rest. }
  FRealTime := IdDemoTime.DateTime;

  DateTimeToSystemTime(FRealTime, NewTime); // Convert a TDateTime value into a TSystemTime (Delphi) for Win API calls
  //if function IsValidDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;

  //edtTimeResult.Text := DateTimeToStr ( IdDemoTime.DateTime );
  //edtTimeResult.Text := DateTimeToStr ( IdDemoTime.DateTime );
  //edtTimeResult.Text := DateTimeToStr ( IdDemoTime.DateTime );
  //edtTimeResult.Text := DateTimeToStr ( IdDemoTime.DateTime );

  if DayLightSavingTime(FRealTime) then
   NewTime.wHour := NewTime.wHour +1;  // Adj for PDST DayLightSavingTime

  NewTDateTime:= SystemTimeToDateTime(NewTime);

  GetDebugPrivs;

  SetLocalTime(NewTime);  // Set the system to the correct time
  PostMessage(HWND_BROADCAST, WM_TIMECHANGE, 0, 0); // Tell windows, that the Time changed!

  Label2.Caption := 'Was:'+DateTimeToStr(FStartDateTime)+' is: '+DateTimeToStr(now)+' should be:'+DateTimeToStr(NewTDateTime);
  edtTimeResult.Text := DateTimeToStr(FRealTime);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -