adaptgeom.dpr

来自「对ima、imz压缩文件修改」· DPR 代码 · 共 110 行

DPR
110
字号
program AdaptGeom;
{$APPTYPE CONSOLE}
  uses
    SysUtils, windows, WIMADLL;

  var
    argc : Integer;
    argv : array of string;
    image : HIMA;
    cDrive : Char;
    wTotal : Word;
    wTotalHigh : Word;
    fGeomIncompatible : Bool;
    fRes : Bool;
    sTemp : string;

  procedure GetParameters();
  var
    commandline : string;
    linepos : Integer;
    quotemode: Bool;

  begin
    argc := 1;
    SetLength(argv, argc);
    linepos := 0;
    quotemode := false;
    commandline := windows.GetCommandLine();

    while (linepos < Length(commandline)) do
    begin
      if (commandline[linepos]='"') then
      begin
        quotemode := not quotemode;
      end
      else
      begin
       if (commandline[linepos]=' ') and not quotemode then
         begin
          argc := argc + 1;
          SetLength(argv, argc);
        end
        else
        begin
          argv[argc-1] := argv[argc-1] +  commandline[linepos];
        end;
      end;
      linepos := linepos + 1;
    end;

  end;

  function EventNotif (dwEvent, dwEventParam, dwWin32Err: LongInt; lpParam, lpUsrParam: Pointer): LongInt;  stdcall;
  begin
    if (dwEvent = DWEV_PROGRESSPERCENT) then
    begin
      Write(Chr(8), Chr(8), Chr(8), Chr(8), IntToStr(dwEventParam), '%');
      //printf("\x08\x08\x08\x08%02u %%",dwEventParam);
    end;
    result := 0;
  end;

begin
  ExitCode := 0;   // Default exit code
  GetParameters(); // Needed to fill argc and argv (like C does)

  if (argc<3) then
  begin
     WriteLn('AdaptGeom');
     WriteLn('Usage : AdaptGeom <imagefile> <drive>');
  end
  else
  begin
    image := OpenLargeImageFile(HWND_NO_PROGRESS, PChar(argv[1]), 0, 0, TRUE);
    // image.unused contains the handle. 0 = invalid
    if (image.unused = 0) then
    begin
      WriteLn('Unable to open ', argv[1]);
      ExitCode := 2;
    end
    else
    begin
      sTemp := argv[2];
      cDrive := sTemp[1];
      wTotal := 0;
      wTotalHigh := 0;
      fGeomIncompatible := FALSE;

      if ((cDrive>='a') and (cDrive<='z')) then
      begin
          cDrive := Chr(Ord(cDrive) - (Ord('a')-Ord('A')));
      end;

      WriteLn('try write to ', cDrive);

      Write('....');

      fRes := WimLargeWriteLargeImaCBEx(image, HWND_NO_PROGRESS, EventNotif, nil, cDrive, @wTotal, @wTotalHigh, USED, false, true, @fGeomIncompatible);

      WriteLn('Result : ', fRes, ', dwTotal=', wTotalHigh, wTotal, ', GeomIncompatible=', fGeomIncompatible);

      if (fRes = false) then
      begin
        ExitCode := 1;
      end;

      DeleteIma(image);
    end;
  end;
end.

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?