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

    • 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. никогда не пейте чай перед выходом из дому в туманую погоду - Вы в нем [тумане] растворитесь.

      Ответить
    • О, НЕТ!!!!!!!!!!!!!!! МОЙ РАСКАЛЁННЫЙ КОПЁР НЕИСТОВО ДОЛБУХОНИТ АНУС "Support"`а!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!! МЫ ОБА СОТРЯСАЕМ НЕБЕСНУЮ ТВЕРДЬ СВОИМИ ВОПЛЯМИ УДОВОЛЬСТВИЯ!!!!!!!!!!!!!!!!!!! СОЛНЦЕ МЕРКНЕТ ПЕРЕД ОГНЁМ СТРАСТИ, ОБУЯВШИМ МЕНЯ!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!
      Ответить
    • >function TIarguments.Clone(out Enum: IEnumVariant): HResult;
      begin
      Result:=E_Notimpl;
      end;

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

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