Einzelnen Beitrag anzeigen

Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.183 Beiträge
 
Delphi 12 Athens
 
#4

Re: Fehler in ParamCount inter D2010?

  Alt 30. Okt 2009, 10:14
hmmmmm

grad Testen lassen ... keine Exception bei ParamStr(2), selbst wenn keine Parameter vorhanden sind (D2010 ohne Update + Win7)

hab hier erstmal was aus 'nem uralten Projekt
müßte nur etwas umgebaut, abgespeckt (die Hexcodierung "#xx" in DequotedStringV brauchste bestimmt nicht) und angepaßt werden (ist 'nen Delphi4-Code, sollte aber mit Unicode keine Probleme haben, fa es schon Unicode ist)
Delphi-Quellcode:
Function ParamCount: LongInt;
Function ParamStr(Index: LongInt): WideString;

Function IsParam (Index: LongInt): Boolean;
Function GetParam(Index: LongInt): WideString;
Function FindParam (Param: WideString; CaseSensitive: Boolean): LongInt;
Function GetParamValue(Param: WideString; CaseSensitive: Boolean): WideString;
Delphi-Quellcode:
Function ParamCount: LongInt;
  Var P: PWideChar;
    B: Boolean;

  Begin
    Result := 0;
    P := GetCommandLineW;
    If P <> nil Then Dec(Result) Else Exit;
    While P^ <> #0 do Begin
      While (P^ <> #0) and (P^ <= ' ') do Inc(P);
      B := False;
      If P^ <> #0 Then Inc(Result);
      While (P^ <> #0) and ((P^ > ' ') or B) do Begin
        If P^ = scQuoteChar Then B := not B;
        Inc(P);
      End;
    End;
  End;

Function ParamStr(Index: LongInt): WideString;
  Var P, P2: PWideChar;
    B: Boolean;

  Begin
    If Index = 0 Then Begin
      _SetLength(Result, MAX_PATH, slUnique);
      _SetLength(Result, GetModuleFileNameW(0, Pointer(Result), MAX_PATH));
      Exit;
    End Else If Index < 0 Then Inc(Index);
    P := GetCommandLineW;
    If P <> nil Then
      While P^ <> #0 do Begin
        While (P^ <> #0) and (P^ <= ' ') do Inc(P);
        P2 := P; B := False;
        While (P2^ <> #0) and ((P2^ > ' ') or B) do Begin
          If P2^ = scQuoteChar Then B := not B;
          Inc(P2);
        End;
        If (Index = 0) and (P <> P2) Then Begin
          _SetLength(Result, P2 - P, slUnique);
          CopyMem(P, Pointer(Result), (P2 - P) * 2);
          DequotedStringV(Result);
          Exit;
        End;
        P := P2;
        Dec(Index);
      End;
    Result := '';
  End;

Function IsParam(Index: LongInt): Boolean;
  Var S: WideString;

  Begin
    S := ParamStr(Index);
    Result := (S <> '') and (S[1] in [WideChar('-'), WideChar('/')]);
  End;

Function GetParam(Index: LongInt): WideString;
  Var S: WideString;
    i: Integer;

  Begin
    S := ParamStr(Index);
    If (S = '') or not (S[1] in [WideChar('-'), WideChar('/')]) Then Begin
      Result := '';
      Exit;
    End;
    i := Pos('=', S);
    If i = 0 Then i := Length(S) + 1 Else Dec(i);
    Result := Copy(S, 2, i - 1);
  End;

Function FindParam(Param: WideString; CaseSensitive: Boolean): LongInt;
  Var i: Integer;
    S: WideString;

  Begin
    If not CaseSensitive Then Param := LowerCase(Param);
    For i := ParamCount downto 1 do Begin
      S := GetParam(i);
      If not CaseSensitive Then S := LowerCase(S);
      If Param = S Then Begin
        Result := i;
        Exit;
      End;
    End;
    Result := 0;
  End;

Function GetParamValue(Param: WideString; CaseSensitive: Boolean): WideString;
  Var i: Integer;

  Begin
    i := FindParam(Param, CaseSensitive);
    If i = 0 Then Result := ''
    Else Result := Copy(ParamStr(i), Length(GetParam(i)) + 1, MaxInt);
  End;


Delphi-Quellcode:
Const scQuoteChar = '"';

Procedure DequotedStringV(Var S: WideString; Typ: SLType = slReal);
  Var B: Boolean;
    i: Integer;

  Begin
    If S = scQuoteChar + scQuoteChar Then Begin S := ''; Exit; End;
    If (S <> '') and (S[1] = scQuoteChar) Then Begin
      Delete(S, 1, 1, Typ);
      B := True;
    End Else B := False;
    i := 1;
    While i <= _Length(S) do Begin
      If S[i] = scQuoteChar Then Begin
        Delete(S, i, 1, Typ);
        If (i > _Length(S)) or (S[i] <> scQuoteChar) Then Begin B := not B; Dec(i); End;
      End Else If (i + 1 < _Length(S)) and (S[i] = '#')
        and (S[i + 1] <= #255) and (AnsiChar(S[i + 1]) in scHexCharSet)
        and (S[i + 2] <= #255) and (AnsiChar(S[i + 2]) in scHexCharSet) Then Begin
        S[i] := WideChar((scHexOrds[AnsiChar(S[i + 1])] shl 4) or scHexOrds[AnsiChar(S[i + 2])]);
        Delete(S, i + 1, 2, Typ);
      End;
      Inc(i);
    End;
  End;
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat