Как написать код с помощью ChatGPT (практическое пособие)

[Arigato]

вот здесь: Succeeded(ShellItem.BindToHandler(n il, BHID_PropertyStore, IID_IPropertyStore, PropertyStore))
говорит, что последний параметр должен быть PPointer

---------------------------------------

### **Ошибка: ожидается `PGUID`, а передан `TGUID`**
Lazarus требует **указатель на `TGUID` (`PGUID`)**, но `IID_IPropertyStore` — это просто `TGUID`.

---

### **Исправленный вызов `BindToHandler`**
Используй **адрес (`@`)** перед `IID_IPropertyStore`:
```pascal

var
  ShellItem: IShellItem2;
  PropertyStore: IPropertyStore;
  P: Pointer;
begin
  if Succeeded(SHCreateItemFromParsingName(PWideChar(WideString(FilePath)), nil, IID_IShellItem2, ShellItem)) then
  begin
    P := nil;
    if Succeeded(ShellItem.BindToHandler(nil, BHID_PropertyStore, @IID_IPropertyStore, P)) then
    begin
      PropertyStore := IPropertyStore(P); // Приведение указателя к интерфейсу
      PropertyStore.Commit;  // Очистка метаданных
    end;
  end;
end;

```

---

### **Почему это работает?**
- `IID_IPropertyStore` — это `TGUID`, но `BindToHandler` ожидает `PGUID` (указатель).
- `@IID_IPropertyStore` **передаёт указатель** на `TGUID`, что решает ошибку.

Теперь код должен компилироваться! ��

Если появятся новые ошибки — пиши, разберём. ��

[Arigato]

следующая ошибка: Error: Incompatible type for arg no. 3: Got "TGuid", expected "PGUID"

---------------------------------------

### **Ошибка: ожидается `PGUID`, а передан `TGUID`**
Lazarus требует **указатель на `TGUID` (`PGUID`)**, но `IID_IPropertyStore` — это просто `TGUID`.

---

### **Исправленный вызов `BindToHandler`**
Используй **адрес (`@`)** перед `IID_IPropertyStore`:
```pascal

var
  ShellItem: IShellItem2;
  PropertyStore: IPropertyStore;
  P: Pointer;
begin
  if Succeeded(SHCreateItemFromParsingName(PWideChar(WideString(FilePath)), nil, IID_IShellItem2, ShellItem)) then
  begin
    P := nil;
    if Succeeded(ShellItem.BindToHandler(nil, BHID_PropertyStore, @IID_IPropertyStore, P)) then
    begin
      PropertyStore := IPropertyStore(P); // Приведение указателя к интерфейсу
      PropertyStore.Commit;  // Очистка метаданных
    end;
  end;
end;

```

---

### **Почему это работает?**
- `IID_IPropertyStore` — это `TGUID`, но `BindToHandler` ожидает `PGUID` (указатель).
- `@IID_IPropertyStore` **передаёт указатель** на `TGUID`, что решает ошибку.

Теперь код должен компилироваться! ��

Если появятся новые ошибки — пиши, разберём. ��

[Arigato]

далее такая ошибка: Error: Identifier not found "TValueVariant"

---------------------------------------

### **Ошибка: `Identifier not found "TValueVariant"`**
В Lazarus нет типа `TValueVariant`. В Delphi он используется для `PROPVARIANT`, но в Free Pascal его нужно заменить.

---

### **Исправленный код с `PROPVARIANT`**
Вместо `TValueVariant(nil)` нужно использовать `InitPropVariantFromBoolean(False)` .

#### **1. Объявляем `InitPropVariantFromBoolean`**
Добавь в код:
```pascal

function InitPropVariantFromBoolean(fVal: Boolean): PROPVARIANT;
begin
  FillChar(Result, SizeOf(Result), 0);
  Result.vt := VT_BOOL;
  Result.boolVal := fVal;
end;

```

#### **2. Используем для очистки свойств**
Вместо:
```pascal

PropertyStore.SetValue(PropertyKey, TValueVariant(nil));

```
Используй:
```pascal

var
  EmptyProp: PROPVARIANT;
begin
  EmptyProp := InitPropVariantFromBoolean(False);
  PropertyStore.SetValue(PropertyKey, EmptyProp);

```

---

### **Почему это работает?**
- В Lazarus **нет `TValueVariant`**, но `PROPVARIANT` используется аналогично.
- **`InitPropVariantFromBoolean(False )`** создаёт пустой `PROPVARIANT`, обнуляя свойство.
- Это соответствует API Windows.

Теперь код должен работать без ошибки! ��
Если будут ещё ошибки — пиши, разберём. ��

[Arigato]

Все равно ошибка: ClearProperties.lpr(106,60) Error: Incompatible type for arg no. 2: Got "PROPVARIANT", expected "TPROPVARIANT"

---------------------------------------

### **Ошибка: ожидался `TPROPVARIANT`, а передан `PROPVARIANT`**
В Free Pascal нет предопределённого `TPROPVARIANT`, но в Windows API `PROPVARIANT` и `TPROPVARIANT` — одно и то же.

---

### **Как исправить?**
Переименуй `PROPVARIANT` в `TPROPVARIANT` при объявлении типа:

```pascal

type
  TPROPVARIANT = packed record
    vt: Word;
    wReserved1, wReserved2, wReserved3: Word;
    case Integer of
      0: (bVal: Byte);
      1: (iVal: SmallInt);
      2: (uiVal: Word);
      3: (lVal: LongInt);
      4: (ulVal: Cardinal);
      5: (hVal: Int64);
      6: (uhVal: UInt64);
      7: (fltVal: Single);
      8: (dblVal: Double);
      9: (bstrVal: PWideChar);
      10: (boolVal: BOOL);
  end;

```

Теперь замени `PROPVARIANT` на `TPROPVARIANT`:

```pascal

function InitPropVariantFromBoolean(fVal: Boolean): TPROPVARIANT;
begin
  FillChar(Result, SizeOf(Result), 0);
  Result.vt := VT_BOOL;
  Result.boolVal := fVal;
end;

```

### **Использование в коде**
```pascal

var
  EmptyProp: TPROPVARIANT;
begin
  EmptyProp := InitPropVariantFromBoolean(False);
  PropertyStore.SetValue(PropertyKey, EmptyProp);

```

---

### **Почему это работает?**
- В Lazarus нет `TPROPVARIANT`, но Windows API ожидает именно его.
- `TPROPVARIANT` теперь правильно совпадает с ожиданиями `SetValue`.

Теперь код должен скомпилироваться! ��
Если всё равно есть ошибка — пиши, разберём. ��

[Arigato]

Тут ошибка: ClearProperties.lpr(137,17) Error: Incompatible type for arg no. 1: Got "TRawbyteSearchRec", expected "QWord"

---------------------------------------

### **Ошибка: `Got "TRawbyteSearchRec", expected "QWord"`**

Эта ошибка обычно возникает при использовании `FindFirst` / `FindNext` для работы с файлами.

#### **Причина ошибки**
`FindFirst` в Lazarus возвращает `TRawbyteSearchRec`, но ты, вероятно, передаёшь его в функцию, ожидающую `QWord`.

#### **Как исправить?**
Если код выглядит так:
```pascal

var
  SR: TRawbyteSearchRec;
begin
  if FindFirst('*.*', faAnyFile, SR) = 0 then
  begin
    ProcessFile(SR);  // <-- ошибка тут
  end;

```
то функция `ProcessFile` ожидает `QWord`, но `SR` — это структура.

##### **Решение 1: Передавать `SR.Size` (размер файла)**
Если `ProcessFile` ожидает размер файла, передавай `SR.Size`:

```pascal

ProcessFile(SR.Size);

```

##### **Решение 2: Передавать имя файла**
Если `ProcessFile` должна работать с файлом, передавай `SR.Name`:

```pascal

ProcessFile(SR.Name);

```

##### **Решение 3: Изменить сигнатуру `ProcessFile`**
Если ты сам писал `ProcessFile`, измени её так:
```pascal

procedure ProcessFile(const SR: TRawbyteSearchRec);

```

---

### **Вывод**
В `FindFirst` исправь передачу `TRawbyteSearchRec` (используй `SR.Size` или `SR.Name`).

Теперь код должен работать! ��
Если будут новые ошибки — пиши, разберём. ��

[Arigato]

Теперь запустилось, но во время выполнения получаю ACCESS VIOLATION

---------------------------------------

### **Ошибка ACCESS VIOLATION: разбор и исправление**

Ошибка **ACCESS VIOLATION** означает, что программа пытается обратиться к памяти, которая не была выделена или уже освобождена.

---

### **Где может быть проблема?**

#### **1. `ShellItem` или `PropertyStore` не были созданы**
Если `SHCreateItemFromParsingName` или `BindToHandler` не сработали, то `ShellItem` или `PropertyStore` равны `nil`, и при вызове метода (`Commit`, `SetValue`) будет ошибка.

#### **✅ Исправление**:
Перед использованием **проверяй**, что `ShellItem` и `PropertyStore` не `nil`:

```pascal

if Assigned(ShellItem) and Assigned(PropertyStore) then
begin
  PropertyStore.Commit;
end
else
begin
  WriteLn('Ошибка: ShellItem или PropertyStore не инициализированы.');
end;

```

---

#### **2. `SHCreateItemFromParsingName` или `BindToHandler` возвращает ошибку**
Если `SHCreateItemFromParsingName` не создаёт `IShellItem2`, то `ShellItem` недействителен.

#### **✅ Исправление**:
Выводи результат вызова функций:

```pascal

var
  hr: HRESULT;
begin
  hr := SHCreateItemFromParsingName(PWideChar(WideString(FilePath)), nil, IID_IShellItem2, ShellItem);
  if Failed(hr) then
  begin
    WriteLn('Ошибка SHCreateItemFromParsingName: ', hr);
    Exit;
  end;

  P := nil;
  hr := ShellItem.BindToHandler(nil, BHID_PropertyStore, @IID_IPropertyStore, P);
  if Failed(hr) then
  begin
    WriteLn('Ошибка BindToHandler: ', hr);
    Exit;
  end;

  PropertyStore := IPropertyStore(P);
  PropertyStore.Commit;
end;

```
Если `hr` < 0, значит, функция завершилась с ошибкой, и программа не должна пытаться использовать объект.

---

#### **3. Ошибка при установке свойства (`SetValue`)**
Если передаёшь некорректный `PROPVARIANT`, будет `ACCESS VIOLATION`.

#### **✅ Исправление**:
Используй `VT_EMPTY` вместо `VT_BOOL`:

```pascal

var
  EmptyProp: TPROPVARIANT;
begin
  FillChar(EmptyProp, SizeOf(EmptyProp), 0);
  EmptyProp.vt := VT_EMPTY;
  PropertyStore.SetValue(PropertyKey, EmptyProp);

```

---

### **Вывод**
1. **Проверяй `Assigned(ShellItem)` и `Assigned(PropertyStore)`.**
2. **Логируй ошибки `SHCreateItemFromParsingName` и `BindToHandler` (см. `hr`).**
3. **Используй `VT_EMPTY` для очистки свойств.**

Попробуй исправить и напиши, если ещё будет `ACCESS VIOLATION`. ��

[Arigato]

Вот полный код, который у меня получился:

program ClearProperties;

uses Windows, ActiveX, ComObj, ShlObj, SysUtils;

const
  BHID_PropertyStore: TGUID = '{0384e1a4-1523-439c-937e-92b25ed5ade2}';
  IID_IPropertyStore: TGUID = '{886d8eeb-8cf2-4446-8d02-cdba1dbdcf99}';
  IID_IShellItem2: TGUID = '{7E9FB0D3-919F-4307-AB2E-9B1860310C93}';

type
  TPropertyKey = packed record
    fmtid: TGUID;
    pid: DWORD;
  end;
  PPropertyKey = ^TPropertyKey;
  // Объявляем IShellItem2 (расширение IShellItem)
  IShellItem2 = interface(IShellItem)
    ['{7E9FB0D3-919F-4307-AB2E-9B1860310C93}']
    function GetPropertyStore(flags: Cardinal; const riid: TGUID; out ppv): HResult; stdcall;
    function GetPropertyStoreWithCreateObject(flags: Cardinal; const punkCreateObject: IUnknown;
      const riid: TGUID; out ppv): HResult; stdcall;
    function GetPropertyStoreForKeys(const rgKeys: PPropertyKey; cKeys: UINT;
      flags: Cardinal; const riid: TGUID; out ppv): HResult; stdcall;
    function GetPropertyDescriptionList(const keyType: TPropertyKey;
      const riid: TGUID; out ppv): HResult; stdcall;
    function Update(const pbc: IBindCtx): HResult; stdcall;
    function GetProperty(const key: TPropertyKey; var pv: PROPVARIANT): HResult; stdcall;
    function GetCLSID(const key: TPropertyKey; out pclsid: TGUID): HResult; stdcall;
    function GetFileTime(const key: TPropertyKey; out pft: FILETIME): HResult; stdcall;
    function GetInt32(const key: TPropertyKey; out pi: Integer): HResult; stdcall;
    function GetString(const key: TPropertyKey; out ppsz: LPWSTR): HResult; stdcall;
    function GetUInt32(const key: TPropertyKey; out pui: Cardinal): HResult; stdcall;
    function GetUInt64(const key: TPropertyKey; out pull: UInt64): HResult; stdcall;
    function GetBool(const key: TPropertyKey; out pf: BOOL): HResult; stdcall;
  end;
  TPROPVARIANT = packed record
    vt: Word;
    wReserved1, wReserved2, wReserved3: Word;
    case Integer of
      0: (bVal: Byte);
      1: (iVal: SmallInt);
      2: (uiVal: Word);
      3: (lVal: LongInt);
      4: (ulVal: Cardinal);
      5: (hVal: Int64);
      6: (uhVal: UInt64);
      7: (fltVal: Single);
      8: (dblVal: Double);
      9: (bstrVal: PWideChar);
      10: (boolVal: BOOL);
  end;
  // Объявляем IPropertyStore
  IPropertyStore = interface(IUnknown)
    ['{886D8EEB-8CF2-4446-8D02-CDBA1DBDCF99}']
    function GetCount(out cProps: Cardinal): HResult; stdcall;
    function GetAt(iProp: Cardinal; out pkey: TPropertyKey): HResult; stdcall;
    function GetValue(const key: TPropertyKey; out pv: TPROPVARIANT): HResult; stdcall;
    function SetValue(const key: TPropertyKey; const propvar: TPROPVARIANT): HResult; stdcall;
    function Commit: HResult; stdcall;
  end;


const
  shell32 = 'shell32.dll';

function SHCreateItemFromParsingName(
  pszPath: LPCWSTR;
  pbc: Pointer;
  const riid: TGUID;
  out ppv
): HResult; stdcall; external shell32 name 'SHCreateItemFromParsingName';

function InitPropVariantFromBoolean(fVal: Boolean): TPROPVARIANT;
begin
  FillChar(Result, SizeOf(Result), 0);
  Result.vt := VT_BOOL;
  Result.boolVal := fVal;
end;

procedure ClearFileProperties(const FilePath: string);
var
  PropertyStore: IPropertyStore;
  PropertyCount, I: Cardinal;
  PropertyKey: TPropertyKey;
  ShellItem: IShellItem2;
  P: Pointer;
  EmptyProp: TPROPVARIANT;
begin
  CoInitialize(nil);
  try
    if Succeeded(SHCreateItemFromParsingName(PWideChar(WideString(FilePath)), nil, IID_IShellItem2, ShellItem)) then
    begin
      P := nil;
      if Succeeded(ShellItem.BindToHandler(nil, @BHID_PropertyStore, @IID_IPropertyStore, P)) then
      begin
        PropertyStore := IPropertyStore(P); // Приводим `Pointer` к `IPropertyStore`
        if Succeeded(PropertyStore.GetCount(PropertyCount)) then
        begin
          for I := 0 to PropertyCount - 1 do
          begin
            if Succeeded(PropertyStore.GetAt(I, PropertyKey)) then begin
              EmptyProp := InitPropVariantFromBoolean(False);
              PropertyStore.SetValue(PropertyKey, EmptyProp); // Обнуляем свойство
            end;
          end;
          PropertyStore.Commit;
        end;
      end;
    end;
  finally
    CoUninitialize;
  end;
end;

procedure ClearPropertiesInCurrentDirectory;
var
  SR: TSearchRec;
  CurrentExe: string;
  CurrentPath: string;
begin
  CurrentExe := ExtractFileName(ParamStr(0));  // Имя исполняемого файла
  CurrentPath := GetCurrentDir;  // Текущий каталог

  if FindFirst(CurrentPath + '\*.*', faAnyFile, SR) = 0 then
  begin
    repeat
      if (SR.Name <> '.') and (SR.Name <> '..') and (SR.Name <> CurrentExe) then
      begin
        // Применяем очистку только к файлам, не папкам
        if (SR.Attr and faDirectory) = 0 then
        begin
          WriteLn('Clear File Properties: ', SR.Name);
          ClearFileProperties(CurrentPath + '\' + SR.Name);
        end;
      end;
    until FindNext(SR) <> 0;
    FindClose(SR);
  end;
end;

var
  FileName: string;

begin
  FileName := Trim(ParamStr(1));
  if FileName <> '' then begin
    if not FileExists(FileName) then begin
      WriteLn('File not found...');
      Halt(1);
    end;
    WriteLn('Clear File Properties: ', FileName);
    ClearFileProperties(FileName);
  end else begin
    ClearPropertiesInCurrentDirectory;
  end;
  readln;
end.

Где и что в этом коде надо поправить, чтобы не получать данную ошибку?

[Arigato]

---------------------------------------

### **Ошибка ACCESS VIOLATION: разбор и исправление**

Твой код почти верный, но в нём есть несколько проблем, которые могут вызывать `ACCESS VIOLATION`.

---

## **�� Где могут быть ошибки?**

### **1. `SHCreateItemFromParsingName` может вернуть `nil`**
Если `SHCreateItemFromParsingName` не находит файл или API не поддерживает этот вызов, `ShellItem` будет `nil`.

### **✅ Исправление**
Перед использованием `ShellItem` проверяй его на `Assigned`:

```pascal

if not Assigned(ShellItem) then
begin
  WriteLn('Ошибка: SHCreateItemFromParsingName не создал ShellItem для ', FilePath);
  Exit;
end;

```

---

### **2. `BindToHandler` может вернуть `nil`**
Если `BindToHandler` не создаёт `PropertyStore`, `P` остаётся `nil`, и при приведении к `IPropertyStore` будет ошибка.

### **✅ Исправление**
Перед приведением `Pointer` к `IPropertyStore` проверяй `P`:

```pascal

if P = nil then
begin
  WriteLn('Ошибка: BindToHandler не создал PropertyStore для ', FilePath);
  Exit;
end;

```

---

### **3. Использование `@BHID_PropertyStore` вместо `BHID_PropertyStore`**
Вызов `ShellItem.BindToHandler(nil, @BHID_PropertyStore, @IID_IPropertyStore, P)` должен передавать `BHID_PropertyStore` без `@`.

### **✅ Исправление**
Используй:
```pascal

if Succeeded(ShellItem.BindToHandler(nil, BHID_PropertyStore, IID_IPropertyStore, P)) then

```
**без `@` перед `BHID_PropertyStore` и `IID_IPropertyStore`**.

---

### **4. `TPROPVARIANT` должен быть очищен перед `SetValue`**
Чтобы избежать ошибок с `SetValue`, используй `VT_EMPTY`, а не `VT_BOOL`.

### **✅ Исправление**
```pascal

FillChar(EmptyProp, SizeOf(EmptyProp), 0);
EmptyProp.vt := VT_EMPTY;
PropertyStore.SetValue(PropertyKey, EmptyProp);

```

---

### **5. `CoInitialize(nil)` должен вызываться в `begin ... end.`**
Ты вызываешь `CoInitialize(nil);` **в начале `try`**, но `CoUninitialize;` выполнится **даже если `CoInitialize` не сработает**.

### **✅ Исправление**
Перенеси `CoInitialize(nil)` перед `try`:

```pascal

CoInitialize(nil);
try
  ClearPropertiesInCurrentDirectory;
finally
  CoUninitialize;
end;

```

---

## **�� Полный исправленный код `ClearFileProperties`**
```pascal

procedure ClearFileProperties(const FilePath: string);
var
  PropertyStore: IPropertyStore;
  PropertyCount, I: Cardinal;
  PropertyKey: TPropertyKey;
  ShellItem: IShellItem2;
  P: Pointer;
  EmptyProp: TPROPVARIANT;
  hr: HRESULT;
begin
  CoInitialize(nil);
  try
    hr := SHCreateItemFromParsingName(PWideChar(WideString(FilePath)), nil, IID_IShellItem2, ShellItem);
    if Failed(hr) or not Assigned(ShellItem) then
    begin
      WriteLn('Ошибка: SHCreateItemFromParsingName не создал ShellItem для ', FilePath);
      Exit;
    end;

    P := nil;
    hr := ShellItem.BindToHandler(nil, BHID_PropertyStore, IID_IPropertyStore, P);
    if Failed(hr) or (P = nil) then
    begin
      WriteLn('Ошибка: BindToHandler не создал PropertyStore для ', FilePath);
      Exit;
    end;

    PropertyStore := IPropertyStore(P);
    hr := PropertyStore.GetCount(PropertyCount);
    if Failed(hr) then
    begin
      WriteLn('Ошибка: GetCount не удалось получить количество свойств.');
      Exit;
    end;

    for I := 0 to PropertyCount - 1 do
    begin
      hr := PropertyStore.GetAt(I, PropertyKey);
      if Succeeded(hr) then
      begin
        FillChar(EmptyProp, SizeOf(EmptyProp), 0);
        EmptyProp.vt := VT_EMPTY;
        PropertyStore.SetValue(PropertyKey, EmptyProp);
      end;
    end;

    hr := PropertyStore.Commit;
    if Failed(hr) then
    begin
      WriteLn('Ошибка: Commit не удалось сохранить изменения.');
    end;
  finally
    CoUninitialize;
  end;
end;

```

---

## **�� Итог**
### **Что исправлено?**
✅ Проверяется `SHCreateItemFromParsingName`
✅ Проверяется `BindToHandler`
✅ Убраны `@` перед `BHID_PropertyStore` и `IID_IPropertyStore`
✅ `PROPVARIANT` теперь `VT_EMPTY`, а не `VT_BOOL`
✅ `CoInitialize(nil);` теперь вызывается **до `try`**

Теперь код должен работать **без `ACCESS VIOLATION`**. ��
Попробуй и напиши, если будут ошибки! ��

[Arigato]

Вот весь код:

program ClearProperties;

uses Windows, ActiveX, ComObj, ShlObj, SysUtils;

const
  BHID_PropertyStore: TGUID = '{0384e1a4-1523-439c-937e-92b25ed5ade2}';
  IID_IPropertyStore: TGUID = '{886d8eeb-8cf2-4446-8d02-cdba1dbdcf99}';
  IID_IShellItem2: TGUID = '{7E9FB0D3-919F-4307-AB2E-9B1860310C93}';

type
  TPropertyKey = packed record
    fmtid: TGUID;
    pid: DWORD;
  end;
  PPropertyKey = ^TPropertyKey;
  // Объявляем IShellItem2 (расширение IShellItem)
  IShellItem2 = interface(IShellItem)
    ['{7E9FB0D3-919F-4307-AB2E-9B1860310C93}']
    function GetPropertyStore(flags: Cardinal; const riid: TGUID; out ppv): HResult; stdcall;
    function GetPropertyStoreWithCreateObject(flags: Cardinal; const punkCreateObject: IUnknown;
      const riid: TGUID; out ppv): HResult; stdcall;
    function GetPropertyStoreForKeys(const rgKeys: PPropertyKey; cKeys: UINT;
      flags: Cardinal; const riid: TGUID; out ppv): HResult; stdcall;
    function GetPropertyDescriptionList(const keyType: TPropertyKey;
      const riid: TGUID; out ppv): HResult; stdcall;
    function Update(const pbc: IBindCtx): HResult; stdcall;
    function GetProperty(const key: TPropertyKey; var pv: PROPVARIANT): HResult; stdcall;
    function GetCLSID(const key: TPropertyKey; out pclsid: TGUID): HResult; stdcall;
    function GetFileTime(const key: TPropertyKey; out pft: FILETIME): HResult; stdcall;
    function GetInt32(const key: TPropertyKey; out pi: Integer): HResult; stdcall;
    function GetString(const key: TPropertyKey; out ppsz: LPWSTR): HResult; stdcall;
    function GetUInt32(const key: TPropertyKey; out pui: Cardinal): HResult; stdcall;
    function GetUInt64(const key: TPropertyKey; out pull: UInt64): HResult; stdcall;
    function GetBool(const key: TPropertyKey; out pf: BOOL): HResult; stdcall;
  end;
  TPROPVARIANT = packed record
    vt: Word;
    wReserved1, wReserved2, wReserved3: Word;
    case Integer of
      0: (bVal: Byte);
      1: (iVal: SmallInt);
      2: (uiVal: Word);
      3: (lVal: LongInt);
      4: (ulVal: Cardinal);
      5: (hVal: Int64);
      6: (uhVal: UInt64);
      7: (fltVal: Single);
      8: (dblVal: Double);
      9: (bstrVal: PWideChar);
      10: (boolVal: BOOL);
  end;
  // Объявляем IPropertyStore
  IPropertyStore = interface(IUnknown)
    ['{886D8EEB-8CF2-4446-8D02-CDBA1DBDCF99}']
    function GetCount(out cProps: Cardinal): HResult; stdcall;
    function GetAt(iProp: Cardinal; out pkey: TPropertyKey): HResult; stdcall;
    function GetValue(const key: TPropertyKey; out pv: TPROPVARIANT): HResult; stdcall;
    function SetValue(const key: TPropertyKey; const propvar: TPROPVARIANT): HResult; stdcall;
    function Commit: HResult; stdcall;
  end;


const
  shell32 = 'shell32.dll';

function SHCreateItemFromParsingName(
  pszPath: LPCWSTR;
  pbc: Pointer;
  const riid: TGUID;
  out ppv
): HResult; stdcall; external shell32 name 'SHCreateItemFromParsingName';

function InitPropVariantFromBoolean(fVal: Boolean): TPROPVARIANT;
begin
  FillChar(Result, SizeOf(Result), 0);
  Result.vt := VT_EMPTY;
  Result.boolVal := fVal;
end;

procedure ClearFileProperties(const FilePath: string);
var
  PropertyStore: IPropertyStore;
  PropertyCount, I: Cardinal;
  PropertyKey: TPropertyKey;
  ShellItem: IShellItem2;
  P: Pointer;
  EmptyProp: TPROPVARIANT;
  hr: HRESULT;
begin
  CoInitialize(nil);
  try
    hr := SHCreateItemFromParsingName(PWideChar(WideString(FilePath)), nil, IID_IShellItem2, ShellItem);
    if Failed(hr) or not Assigned(ShellItem) then
    begin
      WriteLn('Ошибка: SHCreateItemFromParsingName не создал ShellItem для ', FilePath);
      Exit;
    end;

    P := nil;
    hr := ShellItem.BindToHandler(nil, @BHID_PropertyStore, @IID_IPropertyStore, P);
    if Failed(hr) or (P = nil) then
    begin
      WriteLn('Ошибка: BindToHandler не создал PropertyStore для ', FilePath);
      Exit;
    end;

    PropertyStore := IPropertyStore(P);
    hr := PropertyStore.GetCount(PropertyCount);
    if Failed(hr) then
    begin
      WriteLn('Ошибка: GetCount не удалось получить количество свойств.');
      Exit;
    end;

    for I := 0 to PropertyCount - 1 do
    begin
      hr := PropertyStore.GetAt(I, PropertyKey);
      if Succeeded(hr) then
      begin
        FillChar(EmptyProp, SizeOf(EmptyProp), 0);
        EmptyProp.vt := VT_EMPTY;
        PropertyStore.SetValue(PropertyKey, EmptyProp);
      end;
    end;

    hr := PropertyStore.Commit;
    if Failed(hr) then
    begin
      WriteLn('Ошибка: Commit не удалось сохранить изменения.');
    end;
  finally
    CoUninitialize;
  end;
end;

procedure ClearPropertiesInCurrentDirectory;
var
  SR: TSearchRec;
  CurrentExe: string;
  CurrentPath: string;
begin
  CurrentExe := ExtractFileName(ParamStr(0));  // Имя исполняемого файла
  CurrentPath := GetCurrentDir;  // Текущий каталог

  if FindFirst(CurrentPath + '\*.*', faAnyFile, SR) = 0 then
  begin
    repeat
      if (SR.Name <> '.') and (SR.Name <> '..') and (SR.Name <> CurrentExe) then
      begin
        // Применяем очистку только к файлам, не папкам
        if (SR.Attr and faDirectory) = 0 then
        begin
          WriteLn('Clear File Properties: ', SR.Name);
          ClearFileProperties(CurrentPath + '\' + SR.Name);
        end;
      end;
    until FindNext(SR) <> 0;
    FindClose(SR);
  end;
end;

var
  FileName: string;

begin
  FileName := Trim(ParamStr(1));
  if FileName <> '' then begin
    if not FileExists(FileName) then begin
      WriteLn('File not found...');
      Halt(1);
    end;
    WriteLn('Clear File Properties: ', FileName);
    ClearFileProperties(FileName);
  end else begin
    ClearPropertiesInCurrentDirectory;
  end;
  readln;
end.

Та же самая ошибка.

[Arigato]

---------------------------------------

### **Ошибки и исправления**

Твой код **почти** правильный, но есть несколько ошибок, из-за которых происходит `ACCESS VIOLATION`.

---

## **�� Ошибки, вызывающие ACCESS VIOLATION**

### **1. Использование `@BHID_PropertyStore` и `@IID_IPropertyStore`**
Ты передаёшь `@BHID_PropertyStore` и `@IID_IPropertyStore` в `BindToHandler`, но **адрес передавать не нужно**.

✅ **Исправление:**
```pascal

hr := ShellItem.BindToHandler(nil, BHID_PropertyStore, IID_IPropertyStore, P);

```
**Без `@` перед `BHID_PropertyStore` и `IID_IPropertyStore`.**

---

### **2. `TPROPVARIANT.boolVal` используется неправильно**
В `InitPropVariantFromBoolean` ты используешь `VT_EMPTY`, но при этом пишешь `boolVal`.
**`VT_EMPTY` не совместим с `boolVal`**, из-за этого может быть ошибка.

✅ **Исправление:**
```pascal

function InitPropVariantFromBoolean(fVal: Boolean): TPROPVARIANT;
begin
  FillChar(Result, SizeOf(Result), 0);
  Result.vt := VT_BOOL;  // Должно быть VT_BOOL
  Result.boolVal := fVal;
end;

```

Но так как мы обнуляем свойства, **лучше вообще убрать `boolVal` и использовать `VT_EMPTY` прямо в коде**.

---

### **3. Не обнуляется `EmptyProp` перед `SetValue`**
Перед установкой свойства `EmptyProp` должен быть **обнулён**, иначе остаются мусорные данные.

✅ **Исправление:**
```pascal

FillChar(EmptyProp, SizeOf(EmptyProp), 0);
EmptyProp.vt := VT_EMPTY;
PropertyStore.SetValue(PropertyKey, EmptyProp);

```

---

## **�� Полный исправленный код `ClearFileProperties`**
```pascal

procedure ClearFileProperties(const FilePath: string);
var
  PropertyStore: IPropertyStore;
  PropertyCount, I: Cardinal;
  PropertyKey: TPropertyKey;
  ShellItem: IShellItem2;
  P: Pointer;
  EmptyProp: TPROPVARIANT;
  hr: HRESULT;
begin
  CoInitialize(nil);
  try
    hr := SHCreateItemFromParsingName(PWideChar(WideString(FilePath)), nil, IID_IShellItem2, ShellItem);
    if Failed(hr) or not Assigned(ShellItem) then
    begin
      WriteLn('Ошибка: SHCreateItemFromParsingName не создал ShellItem для ', FilePath);
      Exit;
    end;

    P := nil;
    hr := ShellItem.BindToHandler(nil, BHID_PropertyStore, IID_IPropertyStore, P);
    if Failed(hr) or (P = nil) then
    begin
      WriteLn('Ошибка: BindToHandler не создал PropertyStore для ', FilePath);
      Exit;
    end;

    PropertyStore := IPropertyStore(P);
    hr := PropertyStore.GetCount(PropertyCount);
    if Failed(hr) then
    begin
      WriteLn('Ошибка: GetCount не удалось получить количество свойств.');
      Exit;
    end;

    for I := 0 to PropertyCount - 1 do
    begin
      hr := PropertyStore.GetAt(I, PropertyKey);
      if Succeeded(hr) then
      begin
        FillChar(EmptyProp, SizeOf(EmptyProp), 0);
        EmptyProp.vt := VT_EMPTY;
        PropertyStore.SetValue(PropertyKey, EmptyProp);
      end;
    end;

    hr := PropertyStore.Commit;
    if Failed(hr) then
    begin
      WriteLn('Ошибка: Commit не удалось сохранить изменения.');
    end;
  finally
    CoUninitialize;
  end;
end;

```

---

## **�� Итог**
### **Что исправлено?**
✅ **Использование `BHID_PropertyStore` и `IID_IPropertyStore` без `@`**
✅ **Исправлено `InitPropVariantFromBoolean`**
✅ **Обнулён `EmptyProp` перед `SetValue`**

Теперь код **не должен выдавать `ACCESS VIOLATION`**.
Попробуй и напиши, если ошибка останется! ��