himXML (gesprochen himix ML)

[himitsu]

OK, hier mal eine Protierung der neuen Prozedur (ich hoffe es läuft auch so)

Delphi-Quellcode:

.
    Class Procedure TXMLFile.Initialize;
      Procedure OpenLog(Var F: TextFile);
        Var i:  Integer;
          PIDL: Pointer;
          Path: Array[1..MAX_PATH] of Char;

        Begin
          If Succeeded(SHGetSpecialFolderLocation(0, 0{CSIDL_DESKTOP}, PIDL)) Then Begin
            If SHGetPathFromIDList(PIDL, @Path) Then Begin
              Try
                i := Length(ParamStr(0));
                While (i > 0) and (ParamStr(0)[i] <> '\') do Dec(i);
                AssignFile(F, String(PChar(@Path)) + '\' + Copy(ParamStr(0), i + 1, 888) + '.log');
                Try
                  {$i+}
                  Rewrite(F);
                Except
                  Raise EXMLException.Create(Self, 'Initialize', @SInternalError, [3]);
                End;
              Finally
                CoTaskMemFree(PIDL);
              End;
            End Else Begin
              CoTaskMemFree(PIDL);
              Raise EXMLException.Create(Self, 'Initialize', @SInternalError, [2]);
            End;
          End Else Raise EXMLException.Create(Self, 'Initialize', @SInternalError, [1]);
        End;

      Const toHex: Array[0..15] of Char = '0123456789ABCDEF';

      Var Chars, Chars2: Array[Word] of Word;
        C: Word;
        F: TextFile;
        i: Integer;

      Begin
        __DefaultOptions        := XMLDefaultOptions;
        __DefaultTextIndent     := '  ';
        __DefaultLineFeed       := sLineBreak;
        __DefaultValueSeperator := '=';
        __DefaultValueQuotation := '"';
        __PathDelimiter         := '\';

        InitializeCriticalSection(__ArrC_Lock);

        // create lower char list
        ZeroMemory(@Chars, SizeOf(Chars));
        For C := Low(Chars) to High(Chars) do Chars2[C] := C;
        CharLowerBuffW(@Chars2, Length(Chars));
        // copy lower blocks
        CopyMemory(@__LowerBlock0, @Chars2[Low(__LowerBlock0)], SizeOf(__LowerBlock0));
        CopyMemory(@__LowerBlock1, @Chars2[Low(__LowerBlock1)], SizeOf(__LowerBlock1));
        CopyMemory(@__LowerBlock2, @Chars2[Low(__LowerBlock2)], SizeOf(__LowerBlock2));
        CopyMemory(@__LowerBlock3, @Chars2[Low(__LowerBlock3)], SizeOf(__LowerBlock3));
        CopyMemory(@__LowerBlock4, @Chars2[Low(__LowerBlock4)], SizeOf(__LowerBlock4));
        CopyMemory(@__LowerBlock5, @Chars2[Low(__LowerBlock5)], SizeOf(__LowerBlock5));
        CopyMemory(@__LowerBlock6, @Chars2[Low(__LowerBlock6)], SizeOf(__LowerBlock6));
        CopyMemory(@__LowerBlock7, @Chars2[Low(__LowerBlock7)], SizeOf(__LowerBlock7));
        CopyMemory(@__LowerBlock8, @Chars2[Low(__LowerBlock8)], SizeOf(__LowerBlock8));
        CopyMemory(@__LowerBlock9, @Chars2[Low(__LowerBlock9)], SizeOf(__LowerBlock9));
        CopyMemory(@__LowerBlockA, @Chars2[Low(__LowerBlockA)], SizeOf(__LowerBlockA));
        // copy lowercase chars
        For C := Low(Chars) to High(Chars) do Begin
          If Chars2[C] <> C Then Chars[C] := Chars2[C];
          Chars2[C] := C;
        End;
        // create upper char list
        For C := Low(Chars) to High(Chars) do Chars2[C] := C;
        CharUpperBuffW(@Chars2, Length(Chars));
        // copy uppercase chars + check for lower/upper collisions + create check char list
        // + fill non-upper/lower chars (#0)
        For C := Low(Chars) to High(Chars) do Begin
          If Chars2[C] <> C Then
            If Chars[C] <> 0 Then Begin
              __CompareBlock0[Low(__CompareBlock0)] := #0;
              OpenLog(F);
              Try
                WriteLn(F, '>>> himXML - initialize error <<<');
                WriteLn(F, 'please contact the software distributor');
                WriteLn(F, 'file:');
                WriteLn(F, '  ', ParamStr(0));
                WriteLn(F, 'date:');
                WriteLn(F, '  ', DateTimeToStr(Now));
                WriteLn(F, 'info:');
                WriteLn(F, '  C         = #', Ord(C));
                WriteLn(F, '  Chars2[C] = #', Ord(Chars2[C]));
                WriteLn(F, '  Chars[C]  = #', Ord(Chars[C]));
                WriteLn(F);
                WriteLn(F, '*end*');
              Finally
                CloseFile(F);
              End;
              Exit;
            End Else Chars[C] := Chars2[C];
          Chars2[C] := C;
          If Chars[C] = 0 Then Chars[C] := C;
        End;
        // copy upper/lower blocks
        CopyMemory(@__CompareBlock0, @Chars[Low(__CompareBlock0)], SizeOf(__CompareBlock0));
        CopyMemory(@__CompareBlock1, @Chars[Low(__CompareBlock1)], SizeOf(__CompareBlock1));
        CopyMemory(@__CompareBlock2, @Chars[Low(__CompareBlock2)], SizeOf(__CompareBlock2));
        CopyMemory(@__CompareBlock3, @Chars[Low(__CompareBlock3)], SizeOf(__CompareBlock3));
        CopyMemory(@__CompareBlock4, @Chars[Low(__CompareBlock4)], SizeOf(__CompareBlock4));
        CopyMemory(@__CompareBlock5, @Chars[Low(__CompareBlock5)], SizeOf(__CompareBlock5));
        CopyMemory(@__CompareBlock6, @Chars[Low(__CompareBlock6)], SizeOf(__CompareBlock6));
        CopyMemory(@__CompareBlock7, @Chars[Low(__CompareBlock7)], SizeOf(__CompareBlock7));
        CopyMemory(@__CompareBlock8, @Chars[Low(__CompareBlock8)], SizeOf(__CompareBlock8));
        CopyMemory(@__CompareBlock9, @Chars[Low(__CompareBlock9)], SizeOf(__CompareBlock9));
        CopyMemory(@__CompareBlockA, @Chars[Low(__CompareBlockA)], SizeOf(__CompareBlockA));
        // "delete" upper/lower blocks from char list
        CopyMemory(@Chars2[Low(__CompareBlock0)], @__CompareBlock0, SizeOf(__CompareBlock0));
        CopyMemory(@Chars2[Low(__CompareBlock1)], @__CompareBlock1, SizeOf(__CompareBlock1));
        CopyMemory(@Chars2[Low(__CompareBlock2)], @__CompareBlock2, SizeOf(__CompareBlock2));
        CopyMemory(@Chars2[Low(__CompareBlock3)], @__CompareBlock3, SizeOf(__CompareBlock3));
        CopyMemory(@Chars2[Low(__CompareBlock4)], @__CompareBlock4, SizeOf(__CompareBlock4));
        CopyMemory(@Chars2[Low(__CompareBlock5)], @__CompareBlock5, SizeOf(__CompareBlock5));
        CopyMemory(@Chars2[Low(__CompareBlock6)], @__CompareBlock6, SizeOf(__CompareBlock6));
        CopyMemory(@Chars2[Low(__CompareBlock7)], @__CompareBlock7, SizeOf(__CompareBlock7));
        CopyMemory(@Chars2[Low(__CompareBlock8)], @__CompareBlock8, SizeOf(__CompareBlock8));
        CopyMemory(@Chars2[Low(__CompareBlock9)], @__CompareBlock9, SizeOf(__CompareBlock9));
        CopyMemory(@Chars2[Low(__CompareBlockA)], @__CompareBlockA, SizeOf(__CompareBlockA));
        // check for chars out of upper/lower blocks
        If not CompareMem(@Chars, @Chars2, SizeOf(Chars)) Then Begin
          __CompareBlock0[Low(__CompareBlock0)] := #0;
          OpenLog(F);
          Try
            WriteLn(F, '>>> himXML - initialize error <<<');
            WriteLn(F, 'please contact the software distributor');
            WriteLn(F, 'file:');
            WriteLn(F, '  ', ParamStr(0));
            WriteLn(F, 'date:');
            WriteLn(F, '  ', DateTimeToStr(Now));
            WriteLn(F, 'chars:');
            For C := Low(Chars) to High(Chars) do
              If Chars[C] <> Chars2[C] Then Begin
                Write(F, '  ');
                For i := 3 downto 0 do Write(F, toHex[(C shr (i * 4)) and $0F]);
                Write(F, ' [', C:5, ']: ');
                For i := 3 downto 0 do Write(F, toHex[(Ord(Chars[C]) shr (i * 4)) and $0F]);
                Write(F, ' ');
                For i := 3 downto 0 do Write(F, toHex[(Ord(Chars2[C]) shr (i * 4)) and $0F]);
                WriteLn(F);
              End;
            WriteLn(F);
            WriteLn(F, '*end*');
          Finally
            CloseFile(F);
          End;
        End;
      End;

> hab nur die wichtigen Teile rübergezogen und in die alte Initprozedur eingefügt
> und konnte es jetzt noch nicht testen