1. Pascal / Говнокод #28215

    0

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    // реализация интерфейса IArguments2 для самодельного скриптового движка, aka vbs to exe

unit Arguments;

interface

uses
  Windows, ComObj, ActiveX, Stub_TLB, SysUtils,WSHNamedArguments,WSHUnNamedArguments, CmdUtils;

type
  TIarguments=class(TAutoObject, IArguments2, IEnumVariant)
      FAArgs:array of WideString;
      FWSHNamedArguments:TIWSHNamedArguments;
      FWSHUnNamedArguments:TIWSHUnNamedArguments;
      function Item(Index: Integer): WideString; safecall;
    function Count: Integer; safecall;
    function Get_length: Integer; safecall;
    function _NewEnum: IUnknown; safecall;
    property length: Integer read Get_length;
        function Get_Named: IWSHNamedArguments; safecall;
    function Get_Unnamed: IWSHUnnamedArguments; safecall;
    procedure ShowUsage; safecall;
    property Named: IWSHNamedArguments read Get_Named;
    property Unnamed: IWSHUnnamedArguments read Get_Unnamed;
        function Next(celt: LongWord; var rgvar : OleVariant;
      out pceltFetched: LongWord): HResult; stdcall;
    function Skip(celt: LongWord): HResult; stdcall;
    function Reset: HResult; stdcall;
    function Clone(out Enum: IEnumVariant): HResult; stdcall;
    public
    constructor Create;
    end;

    implementation
    

    
uses ComServ;
    

    
var
    
    FIndex:Integer=0;
    

    
{ TIarguments }
    

    
function TIarguments._NewEnum: IUnknown;
    
begin
    
  Result:=self;
    
end;
    

    
function TIarguments.Count: Integer;
    
begin
    
  Result:=System.Length(FAArgs);
    
end;
    

    
function TIarguments.Get_length: Integer;
    
begin
    
   Result:=Count;
    
end;
    

    
function TIarguments.Item(Index: Integer): WideString;
    
begin
    
  if (Index >= System.Length(FAArgs)) then
    
  raise EOleSysError.Create('Range check error', HRESULT($800A0009),0)
    
  else
    
  Result:=FAArgs[Index]
    
end;
    

    
function TIarguments.Get_Named: IWSHNamedArguments;
    
begin
    
  Result:=FWSHNamedArguments;
    
end;
    

    
function TIarguments.Get_Unnamed: IWSHUnnamedArguments;
    
begin
    
  Result:=FWSHUnNamedArguments;
    
end;
    

    
procedure TIarguments.ShowUsage;
    
begin
    
  OleError(E_NOTIMPL);
    
end;
    

    
constructor TIarguments.Create;
    
var
    
  I,J, PCnt:Integer;
    
  S, CmdLine:string;
    
begin
    
  inherited Create;
    
  FIndex:=0;
    
  FWSHNamedArguments:=TIWSHNamedArguments.Create;
    
  FWSHUnNamedArguments:=TIWSHUnNamedArguments.Create;
    
  PCnt:=ParamCount;
    
  SetLength(FAArgs, PCnt);
    
  for I:=1 to PCnt do
    
  begin
    
    J:=I-1;
    
    FAArgs[J]:=ParamStr(I);
    
  end;
    

    
  //Parsing named args.
    

    
  CmdLine:='';
    
  S:=GetCommandLine;
    
  PCnt:=iParamCount(PChar(S));
    
  if PCnt > 1 then
    
  begin
    
    for I:=1 to PCnt-1 do
    
    begin
    
      CmdLine:=CmdLine+iParamStr(PChar(S), I);
    
      if I < PCnt-1 then
    
      CmdLine:=CmdLine+' ';
    
    end;
    
  end;

    Запостил: Support, 09 Июня 2022

    Комментарии (6) RSS

    • ava Support 09.06.2022 19:25 # 0 

      if CmdLine='' then Exit;
  PCnt:=iParamCount(PChar(CmdLine));
  for I:=0 to PCnt-1 do
  begin
    S:=iParamStr(PChar(CmdLine),I);
    if Pos(':', S) >0 then
    begin
      S:=StringReplace(S,'/','',[rfreplaceall]);
      S:=StringReplace(S,'\','',[rfreplaceall]);
      S:=StringReplace(S,'-','',[rfreplaceall]);
      FWSHNamedArguments.NamedArgsList.Add(S);
    end
    else
    FWSHUnNamedArguments.UnNamedArgsList.Add(S);
  end;
end;

function TIarguments.Clone(out Enum: IEnumVariant): HResult;
begin
  Result:=E_Notimpl;
end;

function TIarguments.Next(celt: LongWord; var rgvar: OleVariant;
  out pceltFetched: LongWord): HResult;
var
  S:WideString;
begin
  if Assigned(@pceltFetched) then pceltFetched := 0;
  if (celt <> 1) then
  begin
    Result := E_NOTIMPL;
    Exit;
  end;
  rgvar := 0;
  if System.Length(FAArgs)=0 then
  begin
    Result:=S_FALSE;
    Exit;
  end;
  if FIndex < System.Length(FAArgs) then
  begin
    S:=FAArgs[FIndex];
    rgvar := S;
    Inc(FIndex);
    if Assigned(@pceltFetched) then
    pceltFetched := 1;
    Result := S_OK
  end
  else
   Result := S_FALSE;
end;

function TIarguments.Reset: HResult;
begin
  FIndex := 0;
  Result := S_OK;
end;

function TIarguments.Skip(celt: LongWord): HResult;
begin
  Inc(FIndex, celt);
  Result := S_OK;
  if FIndex >= System.Length(FAArgs) then
  begin
    FIndex := System.Length(FAArgs) - 1;
    Result := S_FALSE;
    end;
end;

initialization
  TAutoObjectFactory.Create(ComServer, TIArguments, CLASS_IArguments_Class,
    ciSingleInstance, tmApartment);

end.



      Вспомнил свой заброшенный проджект аж 2019 года - Roll Builder - утилита для конвертирования скриптов VBS в EXE.
      Конвертирование полное, т.е. ламерский вариант с извлечкой tmp.vbs и запуска во временной директори не прокатит. Полная конвертация, с подменой скриптового хоста wscript на мой. Движок собирается из 4-5 интерфейсов.


      p.s. никогда не пейте чай перед выходом из дому в туманую погоду - Вы в нем [тумане] растворитесь.

      Ответить

    • ava guest6 09.06.2022 21:20 # 0

      О, НЕТ!!!!!!!!!!!!!!! МОЙ РАСКАЛЁННЫЙ КОПЁР НЕИСТОВО ДОЛБУХОНИТ АНУС "Support"`а!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!! МЫ ОБА СОТРЯСАЕМ НЕБЕСНУЮ ТВЕРДЬ СВОИМИ ВОПЛЯМИ УДОВОЛЬСТВИЯ!!!!!!!!!!!!!!!!!!! СОЛНЦЕ МЕРКНЕТ ПЕРЕД ОГНЁМ СТРАСТИ, ОБУЯВШИМ МЕНЯ!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!
      Ответить

    • ava CMEPTb 10.06.2022 17:24 # 0

      >function TIarguments.Clone(out Enum: IEnumVariant): HResult;
      begin
      Result:=E_Notimpl;
      end;

      ой, маткабоска.
      Ответить

      • ava Support 10.06.2022 17:33 # 0

        Что не так? Я хз что такое clone, у меня этот метод никогда не вызывается.
        Ответить

    Добавить комментарий