network time

Are you after some fantastic shortcut/hidden feature or writing a couple of applications (one for the server, one for the client)?

The Neil =:)

This is extrated from a program I did not do.
I am unable to retrieve the original author.

It's just in case what TOndrej  has posted is not working ;)

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Registry, ShlObj, ActiveX;

type
  TMainForm = class(TForm)
    bthBrowse: TButton;
    edtComputerName: TEdit;
    Memo: TMemo;
    btnGet: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure bthBrowseClick(Sender: TObject);
    procedure btnGetClick(Sender: TObject);
  private
    { Private declarations }
    FReg: TRegistry;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

const
  INIT_KEY     = 'Software\NetUtils\Rtod\';
  NERR_Success = 0;

resourcestring
  STop  = 'Top';
  SLeft = 'Left';

type
  NET_API_STATUS = DWORD;

  PTimeOfDayInfo = ^TTimeOfDayInfo;
  TTimeOfDayInfo = packed record
    tod_elapsedt: DWORD;
    tod_msecs: DWORD;
    tod_hours: DWORD;
    tod_mins: DWORD;
    tod_secs: DWORD;
    tod_hunds: DWORD;
    tod_timezone: Longint;
    tod_tinterval: DWORD;
    tod_day: DWORD;
    tod_month: DWORD;
    tod_year: DWORD;
    tod_weekday: DWORD;
  end;

function NetRemoteTOD(UncServerName: LPCWSTR; BufferPtr: PBYTE): NET_API_STATUS; stdcall;
  external 'netapi32.dll' name 'NetRemoteTOD';

function NetApiBufferFree(Buffer: Pointer): NET_API_STATUS; stdcall;
  external 'netapi32.dll' name 'NetApiBufferFree';

function SelectComputer(const Caption: string; out Computer: string): Boolean;
var
   BrowseInfo: TBrowseInfo;
   ShellMalloc: IMalloc;
   RootItemIDList, ItemIDList: PItemIDList;
   Buffer: PChar;
begin
     Result := False;
     Computer := '';
     FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
     if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
     begin
          Buffer := ShellMalloc.Alloc(MAX_COMPUTERNAME_LENGTH + 1);
          try
             SHGetSpecialFolderLocation(0, CSIDL_NETWORK, RootItemIDList);
             with BrowseInfo do
             begin
                  hwndOwner := Application.Handle;
                  pidlRoot := RootItemIDList;
                  pszDisplayName := Buffer;
                  lpszTitle := PChar(Caption);
                  ulFlags := BIF_BROWSEFORCOMPUTER;
             end;
             ItemIDList := ShBrowseForFolder(BrowseInfo);
             Result := ItemIDList <> nil;
             if Result then
             begin
                  ShellMalloc.Free(ItemIDList);
                  Computer := '\\' + AnsiUpperCase(Buffer);
             end;
          finally
             ShellMalloc.Free(RootItemIDList);
             ShellMalloc.Free(Buffer);
          end;
     end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var
   ComputerName: array[0..MAX_COMPUTERNAME_LENGTH] of Char;
   MaxComputerName: Cardinal;
begin
     FReg := TRegistry.Create;
     with FReg do if KeyExists(INIT_KEY) then
     begin
          OpenKey(INIT_KEY, False);
          if ValueExists(STop) then Top := ReadInteger(STop);
          if ValueExists(SLeft) then Left := ReadInteger(SLeft);
          CloseKey;
     end;
     MaxComputerName := SizeOf(ComputerName);
     GetComputerName(ComputerName, MaxComputerName);
     edtComputerName.Text := '\\' + ComputerName;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
     with FReg do
     begin
          OpenKey(INIT_KEY, True);
          WriteInteger(STop, Top);
          WriteInteger(SLeft, Left);
          CloseKey;
     end;
end;

procedure TMainForm.bthBrowseClick(Sender: TObject);
var
   s: string;
begin
     SelectComputer('Select computer', s);
     if s <> '' then edtComputerName.Text := s;
end;

procedure TMainForm.btnGetClick(Sender: TObject);
var
   TimeOfDayInfo: PTimeOfDayInfo;
   ServerName: array[0..255] of WideChar;
   dwRetValue, dwDays, dwSecs: DWORD;
   GMTTime: TSystemTime;
   CurTime, UpTime: TDateTime;
   ts: TTimeStamp;
begin
     StringToWideChar(edtComputerName.Text, @ServerName, SizeOf(ServerName));
     dwRetValue := NetRemoteTOD(@ServerName, PBYTE(@TimeOfDayInfo));
     if dwRetValue <> NERR_Success then
        raise Exception.Create(SysErrorMessage(dwRetValue));
     with TimeOfDayInfo^ do
     begin
          FillChar(GMTTime, SizeOf(GMTTime), 0);
          with GMTTime do
          begin
               wYear := tod_year;
               wMonth := tod_month;
               wDayOfWeek := tod_weekday;
               wDay := tod_day;
               wHour := tod_hours;
               wMinute := tod_mins;
               wSecond := tod_secs;
               wMilliseconds := tod_hunds;
          end;
          CurTime := SystemTimeToDateTime(GMTTime);
          if tod_timezone <> -1 then
             CurTime := CurTime + ((1/24/60) * -(tod_timezone));
          dwDays := 0;
          dwSecs := tod_msecs div 1000;
          if dwSecs >= SecsPerDay then
          begin
               dwDays := dwSecs div SecsPerDay;
               dwSecs := dwSecs mod SecsPerDay;
          end;
          ts.Time := dwSecs * 1000;
          UpTime := TimeStampToDateTime(ts);
          with Memo.Lines do
          begin
               Add(StringOfChar(' ', 40) +  '*** ' + edtComputerName.Text + ' ***');
               Add(Format('System UpTime: %u days, %s hours, %s minutes, %s seconds',
                         [dwDays, FormatDateTime('h', UpTime),
                          FormatDateTime('n', UpTime), FormatDateTime('s', UpTime)]));
               Add(Format('The current date is: %s', [FormatDateTime(ShortDateFormat, CurTime)]));
               Add(Format('The current time is: %s', [FormatDateTime(LongTimeFormat, CurTime)]));
               EndUpdate;
          end;

     end;
     NetApiBufferFree(TimeOfDayInfo);
end;

end.


See you

if u use Fpiette's components go to his site. Under "user made" there's a time client.

SetNetTime(<Adress of your Server>);


function SetNetTime(TimeServer: String): Boolean;
begin
 Result := WinExec(PChar('NET TIME /SET /YES \\'+TimeServer), SW_HIDE) > 31;
end;

Sorry, 'forgot' this question; checking.

Hi florisb,
any success?

Hi again florisb, still checking?

Oops; I haven't been checking... ...I don't need the code anymore...

Points for first answer I suppose...

Greetings.
 
This question is still open today, perhaps it was overlooked or just lost in the volumes.  Please return to this question to update it with comments if more information is needed to get your solution.  If you've been helped by the participating expert(s), you may just convert their comment to the accepted answer and then grade and close.  If an answer has ever been proposed you may not have this option to accept the comment as answer, if that is the case, ask the specific expert you wish to award to post an answer.     This benefits others who then search our PAQ for just this solution, and rewards the experts who have provided information.  A win/win scenario.  Please DO NOT accept this comment as an answer,  it is merely a reminder.
 
If you wish to award multiple participants, you can do so by creating a zero point question in the Community Support topic area, include this link and tell them which experts you'd like to award what amounts.  If you'd like to delete this question, use the same process as above, but explain why you think it should be deleted.  Here is the Community Support link:   https://www.experts-exchange.com/jsp/qList.jsp?ta=commspt
 
You can always click on your profile to see all your open questions, in the event you also have other open items to be resolved.   If your number of Questions Asked is not equal to the number of Answers Graded, choose to VIEW question history, and you'll quickly be able to navigate to your open items to close them as well.
 
I've had excellent help from experts-exchange through the years and find the real key to getting what I need is to remain active in all my questions, responding with results to suggestions until my solution is found, and recommend that highly.
 
Thank you very much for your responsiveness, it is very much appreciated.  
":0)  Asta
 
P.S.  Some of the older questions from last year are not in the proper comment date order, and Engineering has been advised.  

florisb,
No comment has been added lately (825 days), so it's time to clean up this TA.
I will leave a recommendation in the Cleanup topic area for this question:

RECOMMENDATION: PAQ/No Refund
REASON: I didn't tested TOndrej code but, if he or someone else object this, probably I woould recommend points to TOndrej

Please leave any comments here within 7 days.

-- Please DO NOT accept this comment as an answer ! --

Thanks,

knightmad
EE Cleanup Volunteer

:) Is nice to see cleanup working : )