New wrapper for 7zip

[domasz]

I am trying to create a nice wrapper for 7zip API but I have a weird crash.

Code is MPL so everyone will be able to use this wrapper instead of the low level, very popular "sevenzip.pas" by Henri Gourvest

Code: Pascal  [Select][+][-]

1. procedure TSevenUnpack.Extract;
2. begin
3.    //SetLength(FSelectedItems, 2); //uncommenting this causes a crash
4.  
5.   FSelectedItems[0] := 0;
6.   FSelectedItems[1] := 1;
7.  
8.   FHandle.ExtractItems(@FSelectedItems[0], Length(FSelectedItems), false, @Self, @GetStreamCallback);
9.  
10.   if FPrevFile <> nil then FOnNextFileCloseEvent(FPrevFile);
11. end;

[rvk]

Can't you see where it really crashes??
Of course letting Length be 0 there will be no crash (and no extraction).

But the problem eventuelly is in your ProgressCallBack.
Comment everything out there, and it will work.

The problem is in this line:

Code: Pascal  [Select][+][-]

1. Seven := PSevenUnpack(Sender)^;

Probably Sender itself is already a pointer. And you create a pointer to a pointer (which isn't the actual PSevenUnpack instance).

Maybe this will work better (but I haven't tested it):

Code: Pascal  [Select][+][-]

1. Seven := TSevenUnpack(Sender);

BTW. It's better to put the complete project in your post, not individual units. It's more work to create a test project if we want to test it if your don't include everything. So do Project > Publish project (exclude the .res) and everything is zipped complete.

[domasz]

Can't you see where it really crashes??

It says it crashes here but that doesn't make sense:

Code: Pascal  [Select][+][-]

1. if Seven.FCancel then Exit(S_FALSE);

But the problem eventuelly is in your ProgressCallBack.

With LetLength(FSelectedItems, 2); commented out it works just fine. So why does this line make a problem?

Code: Pascal  [Select][+][-]

1. Seven := TSevenUnpack(Sender);

Will try, thanks.

BTW. It's better to put the complete project in your post, not individual units. It's more work to create a test project if we want to test it if your don't include everything. So do Project > Publish project (exclude the .res) and everything is zipped complete.

OK, I'll put all the files.

[rvk]

It says it crashes here but that doesn't make sense:

Code: Pascal  [Select][+][-]

1. if Seven.FCancel then Exit(S_FALSE);

This is logical because you cast Seven to a pointer of a pointer while it should just be a pointer.

With LetLength(FSelectedItems, 2); commented out it works just fine. So why does this line make a problem?

Because if FSelectedItems is 0 then there is nothing to be extracted and ProgressCallBack is never called.

So saying commenting out that line and saying it works... is just like saying it also works if you don't press any buttons 

[domasz]

Because if FSelectedItems is 0 then there is nothing to be extracted and ProgressCallBack is never called.

So saying commenting out that line and saying it works... is just like saying it also works if you don't press any buttons 

Not really. The same line is called just before in a different procedure (Open). So there are always 2 items to unpack and it does unpack them.
So calling this line once (in Open)- works. Twice (Open, then Extract)- doesn't work. Moving this line from Open to Extract- also doesn't work.
Procedure Extract is called immediately after Open.

[rvk]

Not really. The same line is called just before in a different procedure (Open). So there are always 2 items to unpack and it does unpack them.
So calling this line once (in Open)- works. Twice (Open, then Extract)- doesn't work. Moving this line from Open to Extract- also doesn't work.
Procedure Extract is called immediately after Open.

Ha, I see what you mean now.

Seems like "SetLength(FSelectedItems, 2)" in that .Extract is overwrting something (which is strange).

BTW. Why is TSevenUnpack inherited from TCustomControl which is a TWinControl.
It doesn't need to have width/length and parent does it?

Maybe that's the problem. You didn't assign a parent.

I would still just do this if it doesn't need to have form presence (and then it can be used with plain FPC too).

Code: Pascal  [Select][+][-]

1. TSevenUnpack = class(TComponent)

[domasz]

Sure, it can inherit from TComponent but that doesn't change the crash.

[rvk]

Sure, it can inherit from TWinControl but that doesn't change the crash.

Na, but it can introduce some problems down the road.
TWinControl normally needs a form as parent.
Without it, it can cause problems (at least that is my experience with Delphi).

If you don't do anything with parent, width, top, left etc (i.e. doesn't need a form component) you can better inherit from TComponent (which still has an Owner but not a Parent !!).

(Parent and Owner are different, Parent is for screen, Owner is for Create/Free)

Also do correct create and free in your buttonpress because now you don't release anything after the first press of the button.

Code: Pascal  [Select][+][-]

1. procedure TForm1.Button1Click(Sender: TObject);
2. begin
3.   Seven := TSevenUnpack.Create(nil); // <-- this can be nil if not created by the TForm itself (and because you free it yourself)
4.   try
5.     Seven.OnNextFile := @Next;
6.     Seven.OnNextFileClose := @NextClose;
7.     Seven.OnFileProgress := @Progress;
8.     Seven.OnPasswordNeeded := @Pass;
9.     F := TFileStream.Create('test2.7z', fmOpenRead);
10.     Seven.Open(F);
11.     Seven.Extract;
12.   finally
13.     Seven.Free;
14.   end;
15. end;

It doesn;t fix the crash but the flow is better like this.

[rvk]

Sorry about my previous post.
Your Seven is a TForm variable and you use it in Button2... so you DO NEED to create it in FormCreate, not in Button1.Click.

So:

Code: Pascal  [Select][+][-]

1. procedure TForm1.FormCreate(Sender: TObject);
2. begin
3.   Seven := TSevenUnpack.Create(Self);
4. end;
5.  
6. procedure TForm1.Button1Click(Sender: TObject);
7. begin
8.   Seven.OnNextFile := @Next;
9.   Seven.OnNextFileClose := @NextClose;
10.   Seven.OnFileProgress := @Progress;
11.   Seven.OnPasswordNeeded := @Pass;
12.   F := TFileStream.Create('test2.7z', fmOpenRead);
13.   Seven.Open(F);
14.   Seven.Extract;
15. end;
16.  
17. procedure TForm1.Button2Click(Sender: TObject);
18. begin
19.   Seven.CancelNow;
20. end;
21.  
22. procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
23. begin
24.   F.Free;
25.   // Seven.Free; // is done by TForm because of the Create(Self)
26. end;

[domasz]

It's not the cleanest code, just for testing the class. But good points, sure.

ProgressCallback is most likely called from another thread by the DLL. Perhaps I should do something to synchronize access. But PostMessage won't work here (it's a class, not a form).

[rvk]

I can't put my finger on it but I think somehow it has to do with the interfaces you use.
(using interfaces needs a whole other way of thinking, especially that it's not the same as instances of classes)

For example, if you move the FHandle I7zInArchive to the Extract() itself... it works.

Code: Pascal  [Select][+][-]

1. procedure TSevenUnpack.Extract(Str: TStream);
2. begin
3.   FHandle := CreateInArchive(CLSID_CFormat7z);
4.   FHandle.SetPasswordCallback(@Self, @PasswordCallback);
5.   FHandle.OpenStream(T7zStream.Create(Str, soReference));
6.   FHandle.SetProgressCallback(@Self, @ProgressCallback);
7.   SetLength(FSelectedItems, 2); //uncommenting this causes a crash
8.   FSelectedItems[0] := 0;
9.   FSelectedItems[1] := 1;
10.   FHandle.ExtractItems(@FSelectedItems[0], Length(FSelectedItems), false, @Self, @GetStreamCallback);
11.   if FPrevFile <> nil then FOnNextFileCloseEvent(FPrevFile);
12. end;

Otherwise... I think FHandle is freed before coming to Extract (or something).
And that's not a problem if you don't do anything with memory (because the memory is still the same)
but if you are re-getting the memory for FSelectedItems on the heap, the FHandle part is corrupted/overwritten.

(Interfaces are not my second nature so I can't be certain about above)

[domasz]

Interesting, thanks!

[rvk]

Also interesting is that if you set "Range check" or "Verify method calls" to true in your project, your progress isn't executed.
(It fails silently, somehow FCancel is set to True in that case, without you doing so)

I normally set all the "Checks and assertions" and include Heaptrc during testing.
If it runs in that case, you can leave them out in the final code.

Your project does not run with "Range" and "Verify method calls" set.
(even if you comment out said line)

[domasz]

I introduced global variable PPP: TSevenUnpack;
Then:

Code: Pascal  [Select][+][-]

1. procedure TSevenUnpack.Open(Str: TStream);
2. begin
3.   FHandle.SetPasswordCallback(@Self, @PasswordCallback);
4.   FHandle.SetProgressCallback(@Self, @ProgressCallback);
5.   FHandle.OpenStream(T7zStream.Create(Str, soReference));
6.  
7.   PPP := Self;
8.  
9.   SetLength(FSelectedItems, 2);
10. end;  

then in ProgressCallback:

Code: Pascal  [Select][+][-]

1.   Seven := Ppp;

Now it works even with 2xSetLength and "Range" and "Verify method calls". But global variable isn't a nice solution.

[rvk]

Now it works even with 2xSetLength and "Range" and "Verify method calls". But global variable isn't a nice solution.

That still makes sender in the ProgressCallback(sender: Pointer) an invalid or corrupt value.
So it does seem like an ugly hack to fix the issue