Twext umwandeln PetToAsc und AscToPet?

Für allgemeine Fragen zur Programmierung mit PureBasic.
funkheld
Beiträge: 636
Registriert: 31.12.2009 11:58

Twext umwandeln PetToAsc und AscToPet?

Beitrag von funkheld »

Hallo, guten Tag.
Ich habe hier eine C-Routine um Text einzulesen und dann umzuwandeln.
ich brauche das für ein Forth.

Wer kann mir mal bitte helfen das in Purebasic umzuwandeln.
Meine C-Kenntnisse sind als 70-Jähriger mangelhaft.

Code: Alles auswählen

unsigned char petToAscTable[256] = {
0x00,0x01,0x02,0x03,0x04,0x05,0x06,0x07,0x14,0x09,0x0d,0x11,0x93,0x0a,0x0e,0x0f,
0x10,0x0b,0x12,0x13,0x08,0x15,0x16,0x17,0x18,0x19,0x1a,0x1b,0x1c,0x1d,0x1e,0x1f,
0x20,0x21,0x22,0x23,0x24,0x25,0x26,0x27,0x28,0x29,0x2a,0x2b,0x2c,0x2d,0x2e,0x2f,
0x30,0x31,0x32,0x33,0x34,0x35,0x36,0x37,0x38,0x39,0x3a,0x3b,0x3c,0x3d,0x3e,0x3f,
0x40,0x61,0x62,0x63,0x64,0x65,0x66,0x67,0x68,0x69,0x6a,0x6b,0x6c,0x6d,0x6e,0x6f,
0x70,0x71,0x72,0x73,0x74,0x75,0x76,0x77,0x78,0x79,0x7a,0x5b,0x5c,0x5d,0x5e,0x5f,
0xc0,0xc1,0xc2,0xc3,0xc4,0xc5,0xc6,0xc7,0xc8,0xc9,0xca,0xcb,0xcc,0xcd,0xce,0xcf,
0xd0,0xd1,0xd2,0xd3,0xd4,0xd5,0xd6,0xd7,0xd8,0xd9,0xda,0xdb,0xdc,0xdd,0xde,0xdf,
0x80,0x81,0x82,0x83,0x84,0x85,0x86,0x87,0x88,0x89,0x8a,0x8b,0x8c,0x8d,0x8e,0x8f,
0x90,0x91,0x92,0x0c,0x94,0x95,0x96,0x97,0x98,0x99,0x9a,0x9b,0x9c,0x9d,0x9e,0x9f,
0xa0,0xa1,0xa2,0xa3,0xa4,0xa5,0xa6,0xa7,0xa8,0xa9,0xaa,0xab,0xac,0xad,0xae,0xaf,
0xb0,0xb1,0xb2,0xb3,0xb4,0xb5,0xb6,0xb7,0xb8,0xb9,0xba,0xbb,0xbc,0xbd,0xbe,0xbf,
0x60,0x41,0x42,0x43,0x44,0x45,0x46,0x47,0x48,0x49,0x4a,0x4b,0x4c,0x4d,0x4e,0x4f,
0x50,0x51,0x52,0x53,0x54,0x55,0x56,0x57,0x58,0x59,0x5a,0x7b,0x7c,0x7d,0x7e,0x7f,
0xa0,0xa1,0xa2,0xa3,0xa4,0xa5,0xa6,0xa7,0xa8,0xa9,0xaa,0xab,0xac,0xad,0xae,0xaf,
0xb0,0xb1,0xb2,0xb3,0xb4,0xb5,0xb6,0xb7,0xb8,0xb9,0xba,0xbb,0xbc,0xbd,0xbe,0xbf
};

unsigned char ascToPetTable[256] = {
0x00,0x01,0x02,0x03,0x04,0x05,0x06,0x07,0x14,0x20,0x0d,0x11,0x93,0x0a,0x0e,0x0f,
0x10,0x0b,0x12,0x13,0x08,0x15,0x16,0x17,0x18,0x19,0x1a,0x1b,0x1c,0x1d,0x1e,0x1f,
0x20,0x21,0x22,0x23,0x24,0x25,0x26,0x27,0x28,0x29,0x2a,0x2b,0x2c,0x2d,0x2e,0x2f,
0x30,0x31,0x32,0x33,0x34,0x35,0x36,0x37,0x38,0x39,0x3a,0x3b,0x3c,0x3d,0x3e,0x3f,
0x40,0xc1,0xc2,0xc3,0xc4,0xc5,0xc6,0xc7,0xc8,0xc9,0xca,0xcb,0xcc,0xcd,0xce,0xcf,
0xd0,0xd1,0xd2,0xd3,0xd4,0xd5,0xd6,0xd7,0xd8,0xd9,0xda,0x5b,0x5c,0x5d,0x5e,0x5f,
0xc0,0x41,0x42,0x43,0x44,0x45,0x46,0x47,0x48,0x49,0x4a,0x4b,0x4c,0x4d,0x4e,0x4f,
0x50,0x51,0x52,0x53,0x54,0x55,0x56,0x57,0x58,0x59,0x5a,0xdb,0xdc,0xdd,0xde,0xdf,
0x80,0x81,0x82,0x83,0x84,0x85,0x86,0x87,0x88,0x89,0x8a,0x8b,0x8c,0x8d,0x8e,0x8f,
0x90,0x91,0x92,0x0c,0x94,0x95,0x96,0x97,0x98,0x99,0x9a,0x9b,0x9c,0x9d,0x9e,0x9f,
0xa0,0xa1,0xa2,0xa3,0xa4,0xa5,0xa6,0xa7,0xa8,0xa9,0xaa,0xab,0xac,0xad,0xae,0xaf,
0xb0,0xb1,0xb2,0xb3,0xb4,0xb5,0xb6,0xb7,0xb8,0xb9,0xba,0xbb,0xbc,0xbd,0xbe,0xbf,
0x60,0x61,0x62,0x63,0x64,0x65,0x66,0x67,0x68,0x69,0x6a,0x6b,0x6c,0x6d,0x6e,0x6f,
0x70,0x71,0x72,0x73,0x74,0x75,0x76,0x77,0x78,0x79,0x7a,0x7b,0x7c,0x7d,0x7e,0x7f,
0xe0,0xe1,0xe2,0xe3,0xe4,0xe5,0xe6,0xe7,0xe8,0xe9,0xea,0xeb,0xec,0xed,0xee,0xef,
0xf0,0xf1,0xf2,0xf3,0xf4,0xf5,0xf6,0xf7,0xf8,0xf9,0xfa,0xfb,0xfc,0xfd,0xfe,0xff
};


/****************************************************************************/
void PetToAsc( FILE *fin, FILE *fout )
{
    int     c;

    while( (c=getc(fin)) != EOF ) {
        putc( petToAscTable[c], fout );
    }
}

/****************************************************************************/
void AscToPet( FILE *fin, FILE *fout )
{
    int     c;

    while( (c=getc(fin)) != EOF ) {
        if (c != 0xd) {
            putc( ascToPetTable[c], fout );
        }
    }
}
danke.
gruss
Benutzeravatar
mk-soft
Beiträge: 3701
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Twext umwandeln PetToAsc und AscToPet?

Beitrag von mk-soft »

In Arbeit...

Noch nicht getestet :wink:

Bugfix Filter Zeichen $0D

Code: Alles auswählen

;-TOP

EnableExplicit

; *****************************************************************************

Structure udtArray
  StructureUnion
    a.a[0]
  EndStructureUnion
EndStructure

; -----------------------------------------------------------------------------

Procedure PetToAsc(file_in.s, file_out.s)
  Protected r1, f_in, f_out, size, index, *mem.udtArray, *table.udtArray, ch
  
  ; Tabelle lesen
  f_in = ReadFile(#PB_Any, file_in)
  If f_in = 0
    Debug "Fehler: Datei öffnen - " + file_in
    ProcedureReturn 0
  EndIf
  size = Lof(f_in)
  If size <= 0
    Debug "Fehler: Datei grösse - " + file_in
    CloseFile(f_in)
    ProcedureReturn 0
  EndIf
  *mem = AllocateMemory(size)
  If *mem = 0
    Debug "Fehler: Speicher anlegen - " + file_in
    CloseFile(f_in)
    ProcedureReturn 0
  EndIf
  r1 = ReadData(f_in, *mem, size)
  If r1 <> size
    Debug "Fehler: Datei laden - " + file_in
    FreeMemory(*mem)
    CloseFile(f_in)
    ProcedureReturn 0
  EndIf
  CloseFile(f_in)
  
  ; Tabelle übersetzen
  *table = ?PetToAscTable
  size - 1
  For index = 0 To size
    ch = *mem\a[index]
    *mem\a[index] = *table\a[ch]
  Next
  ; Tabelle schreiben
  f_out = CreateFile(#PB_Any, file_out)
  If f_out = 0
    Debug "Fehler: Datei erstellen - " + file_out
    FreeMemory(*mem)
    ProcedureReturn 0
  EndIf
  size + 1
  r1 = WriteData(f_out, *mem, size)
  If r1 <> size
    Debug "Fehler: Datei schreiben - " + file_out
    CloseFile(f_out)
    DeleteFile(file_out)
    FreeMemory(*mem)
    ProcedureReturn 0
  EndIf
  ; Ok
  CloseFile(f_out)
  FreeMemory(*mem)
  ProcedureReturn r1
  
EndProcedure

; -----------------------------------------------------------------------------

Procedure AscToPet(file_in.s, file_out.s)
  Protected r1, f_in, f_out, size, index, index2, *mem.udtArray, *mem2.udtArray, *table.udtArray, ch.a
  
  ; Tabelle lesen
  f_in = ReadFile(#PB_Any, file_in)
  If f_in = 0
    Debug "Fehler: Datei öffnen - " + file_in
    ProcedureReturn 0
  EndIf
  size = Lof(f_in)
  If size <= 0
    Debug "Fehler: Datei grösse - " + file_in
    CloseFile(f_in)
    ProcedureReturn 0
  EndIf
  *mem = AllocateMemory(size)
  If *mem = 0
    Debug "Fehler: Speicher quelle anlegen - " + file_in
    CloseFile(f_in)
    ProcedureReturn 0
  EndIf
  r1 = ReadData(f_in, *mem, size)
  If r1 <> size
    Debug "Fehler: Datei laden - " + file_in
    FreeMemory(*mem)
    CloseFile(f_in)
    ProcedureReturn 0
  EndIf
  CloseFile(f_in)
  
  ; Tabelle übersetzen
  *table = ?AscToPetTable
  *mem2 = AllocateMemory(size)
  If *mem2 = 0
    Debug "Fehler: Speicher ziel anlegen - " + file_in
    FreeMemory(*mem)
    ProcedureReturn 0
  EndIf
  size - 1
  For index = 0 To size
    ch = *mem\a[index]
    If ch <> $0d 
      *mem2\a[index2] = *table\a[ch]
      index2 + 1
    EndIf
  Next
  FreeMemory(*mem)
  ; Tabelle schreiben
  f_out = CreateFile(#PB_Any, file_out)
  If f_out = 0
    Debug "Fehler: Datei erstellen - " + file_out
    FreeMemory(*mem2)
    ProcedureReturn 0
  EndIf
  size = index2
  r1 = WriteData(f_out, *mem2, size)
  If r1 <> size
    Debug "Fehler: Datei schreiben - " + file_out
    CloseFile(f_out)
    DeleteFile(file_out)
    FreeMemory(*mem2)
    ProcedureReturn 0
  EndIf
  ; Ok
  CloseFile(f_out)
  FreeMemory(*mem2)
  ProcedureReturn r1
  
EndProcedure

; -----------------------------------------------------------------------------

Procedure PetToAscMemory(file_in.s) ; Result Pointer to Memory
  Protected r1, f_in, size, index, *mem.udtArray, *table.udtArray, ch
  
  ; Tabelle lesen
  f_in = ReadFile(#PB_Any, file_in)
  If f_in = 0
    Debug "Fehler: Datei öffnen - " + file_in
    ProcedureReturn 0
  EndIf
  size = Lof(f_in)
  If size <= 0
    Debug "Fehler: Datei grösse - " + file_in
    CloseFile(f_in)
    ProcedureReturn 0
  EndIf
  *mem = AllocateMemory(size)
  If *mem = 0
    Debug "Fehler: Speicher anlegen - " + file_in
    CloseFile(f_in)
    ProcedureReturn 0
  EndIf
  r1 = ReadData(f_in, *mem, size)
  If r1 <> size
    Debug "Fehler: Datei laden - " + file_in
    FreeMemory(*mem)
    CloseFile(f_in)
    ProcedureReturn 0
  EndIf
  CloseFile(f_in)
  
  ; Tabelle übersetzen
  *table = ?PetToAscTable
  size - 1
  For index = 0 To size
    ch = *mem\a[index]
    *mem\a[index] = *table\a[ch]
  Next
  ; Ok
  ProcedureReturn *mem
  
EndProcedure

; -----------------------------------------------------------------------------

Procedure AscToPetMemory(file_in.s) ; Result Pointer to Memory
  Protected r1, f_in, size, index, index2, *mem.udtArray, *mem2.udtArray, *table.udtArray, ch.a
  
  ; Tabelle lesen
  f_in = ReadFile(#PB_Any, file_in)
  If f_in = 0
    Debug "Fehler: Datei öffnen - " + file_in
    ProcedureReturn 0
  EndIf
  size = Lof(f_in)
  If size <= 0
    Debug "Fehler: Datei grösse - " + file_in
    CloseFile(f_in)
    ProcedureReturn 0
  EndIf
  *mem = AllocateMemory(size)
  If *mem = 0
    Debug "Fehler: Speicher quelle anlegen - " + file_in
    CloseFile(f_in)
    ProcedureReturn 0
  EndIf
  r1 = ReadData(f_in, *mem, size)
  If r1 <> size
    Debug "Fehler: Datei laden - " + file_in
    FreeMemory(*mem)
    CloseFile(f_in)
    ProcedureReturn 0
  EndIf
  CloseFile(f_in)
  
  ; Tabelle übersetzen
  *table = ?AscToPetTable
  *mem2 = AllocateMemory(size)
  If *mem2 = 0
    Debug "Fehler: Speicher ziel anlegen - " + file_in
    FreeMemory(*mem)
    ProcedureReturn 0
  EndIf
  size - 1
  For index = 0 To size
    ch = *mem\a[index]
    If ch <> $0d 
      *mem2\a[index2] = *table\a[ch]
      index2 + 1
    EndIf
  Next
  FreeMemory(*mem)
  *mem2 = ReAllocateMemory(*mem2, index2)
  ProcedureReturn *mem2
  
EndProcedure

; -----------------------------------------------------------------------------

DataSection
  PetToAscTable:
  Data.a $00,$01,$02,$03,$04,$05,$06,$07,$14,$09,$0d,$11,$93,$0a,$0e,$0f
  Data.a $10,$0b,$12,$13,$08,$15,$16,$17,$18,$19,$1a,$1b,$1c,$1d,$1e,$1f
  Data.a $20,$21,$22,$23,$24,$25,$26,$27,$28,$29,$2a,$2b,$2c,$2d,$2e,$2f
  Data.a $30,$31,$32,$33,$34,$35,$36,$37,$38,$39,$3a,$3b,$3c,$3d,$3e,$3f
  Data.a $40,$61,$62,$63,$64,$65,$66,$67,$68,$69,$6a,$6b,$6c,$6d,$6e,$6f
  Data.a $70,$71,$72,$73,$74,$75,$76,$77,$78,$79,$7a,$5b,$5c,$5d,$5e,$5f
  Data.a $c0,$c1,$c2,$c3,$c4,$c5,$c6,$c7,$c8,$c9,$ca,$cb,$cc,$cd,$ce,$cf
  Data.a $d0,$d1,$d2,$d3,$d4,$d5,$d6,$d7,$d8,$d9,$da,$db,$dc,$dd,$de,$df
  Data.a $80,$81,$82,$83,$84,$85,$86,$87,$88,$89,$8a,$8b,$8c,$8d,$8e,$8f
  Data.a $90,$91,$92,$0c,$94,$95,$96,$97,$98,$99,$9a,$9b,$9c,$9d,$9e,$9f
  Data.a $a0,$a1,$a2,$a3,$a4,$a5,$a6,$a7,$a8,$a9,$aa,$ab,$ac,$ad,$ae,$af
  Data.a $b0,$b1,$b2,$b3,$b4,$b5,$b6,$b7,$b8,$b9,$ba,$bb,$bc,$bd,$be,$bf
  Data.a $60,$41,$42,$43,$44,$45,$46,$47,$48,$49,$4a,$4b,$4c,$4d,$4e,$4f
  Data.a $50,$51,$52,$53,$54,$55,$56,$57,$58,$59,$5a,$7b,$7c,$7d,$7e,$7f
  Data.a $a0,$a1,$a2,$a3,$a4,$a5,$a6,$a7,$a8,$a9,$aa,$ab,$ac,$ad,$ae,$af
  Data.a $b0,$b1,$b2,$b3,$b4,$b5,$b6,$b7,$b8,$b9,$ba,$bb,$bc,$bd,$be,$bf
  
  AscToPetTable:
  Data.a $00,$01,$02,$03,$04,$05,$06,$07,$14,$20,$0d,$11,$93,$0a,$0e,$0f
  Data.a $10,$0b,$12,$13,$08,$15,$16,$17,$18,$19,$1a,$1b,$1c,$1d,$1e,$1f
  Data.a $20,$21,$22,$23,$24,$25,$26,$27,$28,$29,$2a,$2b,$2c,$2d,$2e,$2f
  Data.a $30,$31,$32,$33,$34,$35,$36,$37,$38,$39,$3a,$3b,$3c,$3d,$3e,$3f
  Data.a $40,$c1,$c2,$c3,$c4,$c5,$c6,$c7,$c8,$c9,$ca,$cb,$cc,$cd,$ce,$cf
  Data.a $d0,$d1,$d2,$d3,$d4,$d5,$d6,$d7,$d8,$d9,$da,$5b,$5c,$5d,$5e,$5f
  Data.a $c0,$41,$42,$43,$44,$45,$46,$47,$48,$49,$4a,$4b,$4c,$4d,$4e,$4f
  Data.a $50,$51,$52,$53,$54,$55,$56,$57,$58,$59,$5a,$db,$dc,$dd,$de,$df
  Data.a $80,$81,$82,$83,$84,$85,$86,$87,$88,$89,$8a,$8b,$8c,$8d,$8e,$8f
  Data.a $90,$91,$92,$0c,$94,$95,$96,$97,$98,$99,$9a,$9b,$9c,$9d,$9e,$9f
  Data.a $a0,$a1,$a2,$a3,$a4,$a5,$a6,$a7,$a8,$a9,$aa,$ab,$ac,$ad,$ae,$af
  Data.a $b0,$b1,$b2,$b3,$b4,$b5,$b6,$b7,$b8,$b9,$ba,$bb,$bc,$bd,$be,$bf
  Data.a $60,$61,$62,$63,$64,$65,$66,$67,$68,$69,$6a,$6b,$6c,$6d,$6e,$6f
  Data.a $70,$71,$72,$73,$74,$75,$76,$77,$78,$79,$7a,$7b,$7c,$7d,$7e,$7f
  Data.a $e0,$e1,$e2,$e3,$e4,$e5,$e6,$e7,$e8,$e9,$ea,$eb,$ec,$ed,$ee,$ef
  Data.a $f0,$f1,$f2,$f3,$f4,$f5,$f6,$f7,$f8,$f9,$fa,$fb,$fc,$fd,$fe,$ff
  
EndDataSection

; *****************************************************************************

CompilerIf #PB_Compiler_IsMainFile
  
  Define ch_asc, ch_pet, i, *asc.udtArray, *pet.udtArray 
  
  Define r1
  Define fasc.s = OpenFileRequester("Testdatei", "", "", 0)
  Define fpet.s = fasc + ".pet"
  If Bool(fasc)
    r1 = AscToPet(fasc, fpet)
    Debug r1
    fasc + ".asc"
    r1 = PetToAsc(fpet, fasc)
    Debug r1
  EndIf
  
  Define *mem_asc.udtArray
  *mem_asc = PetToAscMemory(fpet)
  If *mem_asc
    ShowMemoryViewer(*mem_asc, MemorySize(*mem_asc))
  EndIf
  
CompilerEndIf
P.S. Test hinzugefügt
Zuletzt geändert von mk-soft am 28.10.2018 17:20, insgesamt 2-mal geändert.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
Mijikai
Beiträge: 754
Registriert: 25.09.2016 01:42

Re: Twext umwandeln PetToAsc und AscToPet?

Beitrag von Mijikai »

Hier noch ein Beispiel :)

Code: Alles auswählen

Procedure.i PetToAscBuffer(*Buffer,BufferSize.i)
  Protected *Offset.Ascii
  Protected *Asc.Ascii
  If *Buffer And BufferSize > 0
    For *Offset = *Buffer To *Buffer + BufferSize - 1
      *Asc = ?PetToAscTable + *Offset\a
      *Offset\a = *Asc\a
    Next
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
  PetToAscTable:
  !db 0x00,0x01,0x02,0x03,0x04,0x05,0x06,0x07,0x14,0x09,0x0d,0x11,0x93,0x0a,0x0e,0x0f
  !db 0x10,0x0b,0x12,0x13,0x08,0x15,0x16,0x17,0x18,0x19,0x1a,0x1b,0x1c,0x1d,0x1e,0x1f
  !db 0x20,0x21,0x22,0x23,0x24,0x25,0x26,0x27,0x28,0x29,0x2a,0x2b,0x2c,0x2d,0x2e,0x2f
  !db 0x30,0x31,0x32,0x33,0x34,0x35,0x36,0x37,0x38,0x39,0x3a,0x3b,0x3c,0x3d,0x3e,0x3f
  !db 0x40,0x61,0x62,0x63,0x64,0x65,0x66,0x67,0x68,0x69,0x6a,0x6b,0x6c,0x6d,0x6e,0x6f
  !db 0x70,0x71,0x72,0x73,0x74,0x75,0x76,0x77,0x78,0x79,0x7a,0x5b,0x5c,0x5d,0x5e,0x5f
  !db 0xc0,0xc1,0xc2,0xc3,0xc4,0xc5,0xc6,0xc7,0xc8,0xc9,0xca,0xcb,0xcc,0xcd,0xce,0xcf
  !db 0xd0,0xd1,0xd2,0xd3,0xd4,0xd5,0xd6,0xd7,0xd8,0xd9,0xda,0xdb,0xdc,0xdd,0xde,0xdf
  !db 0x80,0x81,0x82,0x83,0x84,0x85,0x86,0x87,0x88,0x89,0x8a,0x8b,0x8c,0x8d,0x8e,0x8f
  !db 0x90,0x91,0x92,0x0c,0x94,0x95,0x96,0x97,0x98,0x99,0x9a,0x9b,0x9c,0x9d,0x9e,0x9f
  !db 0xa0,0xa1,0xa2,0xa3,0xa4,0xa5,0xa6,0xa7,0xa8,0xa9,0xaa,0xab,0xac,0xad,0xae,0xaf
  !db 0xb0,0xb1,0xb2,0xb3,0xb4,0xb5,0xb6,0xb7,0xb8,0xb9,0xba,0xbb,0xbc,0xbd,0xbe,0xbf
  !db 0x60,0x41,0x42,0x43,0x44,0x45,0x46,0x47,0x48,0x49,0x4a,0x4b,0x4c,0x4d,0x4e,0x4f
  !db 0x50,0x51,0x52,0x53,0x54,0x55,0x56,0x57,0x58,0x59,0x5a,0x7b,0x7c,0x7d,0x7e,0x7f
  !db 0xa0,0xa1,0xa2,0xa3,0xa4,0xa5,0xa6,0xa7,0xa8,0xa9,0xaa,0xab,0xac,0xad,0xae,0xaf
  !db 0xb0,0xb1,0xb2,0xb3,0xb4,0xb5,0xb6,0xb7,0xb8,0xb9,0xba,0xbb,0xbc,0xbd,0xbe,0xbf
EndProcedure

Procedure.i AscToPetBuffer(*Buffer,BufferSize.i)
  Protected *Offset.Ascii
  Protected *Output
  Protected OutputSize.i
  Protected *Pointer.Ascii
  Protected *Pet.Ascii
  If *Buffer And BufferSize > 0
    *Output = AllocateMemory(BufferSize)
    If *Output
      *Pointer = *Output 
      For *Offset = *Buffer To *Buffer + BufferSize - 1
        If Not *Offset\a = $D
          *Pet = ?AscToPetTable + *Offset\a
          *Pointer\a = *Pet\a
          *Pointer + 1
        EndIf
      Next
      OutputSize = *Pointer - *Output
      If OutputSize
        CopyMemory(*Output,*Buffer,OutputSize)
      EndIf
      FreeMemory(*Output)
      ProcedureReturn OutputSize
    EndIf 
  EndIf
  ProcedureReturn #False
  AscToPetTable:
  !db 0x00,0x01,0x02,0x03,0x04,0x05,0x06,0x07,0x14,0x20,0x0d,0x11,0x93,0x0a,0x0e,0x0f
  !db 0x10,0x0b,0x12,0x13,0x08,0x15,0x16,0x17,0x18,0x19,0x1a,0x1b,0x1c,0x1d,0x1e,0x1f
  !db 0x20,0x21,0x22,0x23,0x24,0x25,0x26,0x27,0x28,0x29,0x2a,0x2b,0x2c,0x2d,0x2e,0x2f
  !db 0x30,0x31,0x32,0x33,0x34,0x35,0x36,0x37,0x38,0x39,0x3a,0x3b,0x3c,0x3d,0x3e,0x3f
  !db 0x40,0xc1,0xc2,0xc3,0xc4,0xc5,0xc6,0xc7,0xc8,0xc9,0xca,0xcb,0xcc,0xcd,0xce,0xcf
  !db 0xd0,0xd1,0xd2,0xd3,0xd4,0xd5,0xd6,0xd7,0xd8,0xd9,0xda,0x5b,0x5c,0x5d,0x5e,0x5f
  !db 0xc0,0x41,0x42,0x43,0x44,0x45,0x46,0x47,0x48,0x49,0x4a,0x4b,0x4c,0x4d,0x4e,0x4f
  !db 0x50,0x51,0x52,0x53,0x54,0x55,0x56,0x57,0x58,0x59,0x5a,0xdb,0xdc,0xdd,0xde,0xdf
  !db 0x80,0x81,0x82,0x83,0x84,0x85,0x86,0x87,0x88,0x89,0x8a,0x8b,0x8c,0x8d,0x8e,0x8f
  !db 0x90,0x91,0x92,0x0c,0x94,0x95,0x96,0x97,0x98,0x99,0x9a,0x9b,0x9c,0x9d,0x9e,0x9f
  !db 0xa0,0xa1,0xa2,0xa3,0xa4,0xa5,0xa6,0xa7,0xa8,0xa9,0xaa,0xab,0xac,0xad,0xae,0xaf
  !db 0xb0,0xb1,0xb2,0xb3,0xb4,0xb5,0xb6,0xb7,0xb8,0xb9,0xba,0xbb,0xbc,0xbd,0xbe,0xbf
  !db 0x60,0x61,0x62,0x63,0x64,0x65,0x66,0x67,0x68,0x69,0x6a,0x6b,0x6c,0x6d,0x6e,0x6f
  !db 0x70,0x71,0x72,0x73,0x74,0x75,0x76,0x77,0x78,0x79,0x7a,0x7b,0x7c,0x7d,0x7e,0x7f
  !db 0xe0,0xe1,0xe2,0xe3,0xe4,0xe5,0xe6,0xe7,0xe8,0xe9,0xea,0xeb,0xec,0xed,0xee,0xef
  !db 0xf0,0xf1,0xf2,0xf3,0xf4,0xf5,0xf6,0xf7,0xf8,0xf9,0xfa,0xfb,0xfc,0xfd,0xfe,0xff
EndProcedure

Procedure.i PetToAsc(FileIn.s,FileOut.s)
  Protected InHandle.i
  Protected OutHandle.i
  Protected *Buffer
  Protected BufferSize.i
  Protected Result.i
  InHandle = ReadFile(#PB_Any,FileIn)
  If InHandle
    BufferSize = Lof(InHandle)
    If BufferSize
      *Buffer = AllocateMemory(BufferSize)
      If *Buffer
        If ReadData(InHandle,*Buffer,BufferSize) = BufferSize
          If PetToAscBuffer(*Buffer,BufferSize)
            OutHandle = CreateFile(#PB_Any,FileOut)
            If OutHandle 
              Result = Bool(WriteData(OutHandle,*Buffer,BufferSize) = BufferSize)
              CloseFile(OutHandle)
              If Not Result
                DeleteFile(FileOut)
              EndIf
            EndIf
          EndIf
        EndIf
        FreeMemory(*Buffer)
      EndIf 
    EndIf
    CloseFile(InHandle)
  EndIf
  ProcedureReturn Result
EndProcedure

Procedure.i AscToPed(FileIn.s,FileOut.s)
  Protected InHandle.i
  Protected OutHandle.i
  Protected *Buffer
  Protected BufferSize.i
  Protected Result.i
  InHandle = ReadFile(#PB_Any,FileIn)
  If InHandle
    BufferSize = Lof(InHandle)
    If BufferSize
      *Buffer = AllocateMemory(BufferSize)
      If *Buffer
        If ReadData(InHandle,*Buffer,BufferSize) = BufferSize
          BufferSize = AscToPetBuffer(*Buffer,BufferSize)
          If BufferSize
            OutHandle = CreateFile(#PB_Any,FileOut)
            If OutHandle 
              Result = Bool(WriteData(OutHandle,*Buffer,BufferSize) = BufferSize)
              CloseFile(OutHandle)
              If Not Result
                DeleteFile(FileOut)
              EndIf
            EndIf
          EndIf
        EndIf
        FreeMemory(*Buffer)
      EndIf 
    EndIf
    CloseFile(InHandle)
  EndIf
  ProcedureReturn Result
EndProcedure
(ungetestet)
Zuletzt geändert von Mijikai am 28.10.2018 16:58, insgesamt 1-mal geändert.
Benutzeravatar
mk-soft
Beiträge: 3701
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Twext umwandeln PetToAsc und AscToPet?

Beitrag von mk-soft »

Ok...

nach Mijikai Anregung auch mit Rückgabe auf ein Speicher.

@Mijikai
Ein direkter Zugriff über Strukturen ist immer schneller als die Funktion Peek und Poke aufzurufen.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
Mijikai
Beiträge: 754
Registriert: 25.09.2016 01:42

Re: Twext umwandeln PetToAsc und AscToPet?

Beitrag von Mijikai »

mk-soft hat geschrieben: @Mijikai
Ein direkter Zugriff über Strukturen ist immer schneller als die Funktion Peek und Poke aufzurufen.
Hab PeekA() entfernt :)
Benutzeravatar
mk-soft
Beiträge: 3701
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Twext umwandeln PetToAsc und AscToPet?

Beitrag von mk-soft »

Bugfix
Habe noch ein Bug bei mir gefunden.
Habe vergessen das Zeichen $0D zu filtern bei Übersetzung von Asc zu Pet
while( (c=getc(fin)) != EOF ) {
if (c != 0xd) {
putc( ascToPetTable[c], fout );
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
funkheld
Beiträge: 636
Registriert: 31.12.2009 11:58

Re: Twext umwandeln PetToAsc und AscToPet?

Beitrag von funkheld »

Danke für die Hilfe.

Wusste nicht, das es so viel ist.

Wo muss das bitte noch eingesetzt werden?
-------------------------------------------
while( (c=getc(fin)) != EOF ) {
if (c != 0xd) {
putc( ascToPetTable[c], fout );
-------------------------------------------

Vielen dank.
Gruss
Benutzeravatar
mk-soft
Beiträge: 3701
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Twext umwandeln PetToAsc und AscToPet?

Beitrag von mk-soft »

Ist schon korrigiert... :wink:

Sieht bei mir nur so viel aus wegen der ganzen Fehlerauswertung.

Im "C" Beispiel ist auch kein öffnen der Dateien mit drin und keine Kontrolle ob alles funktioniert hat.
Ausserdem gleich optimiert die Dateien komplett über Speicher laden und schreiben.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Antworten