FreeBasic: Programm von AU3 nach FB Portieren

Techmix

Hallo,
Ich benötige jemanden der relativ gut FreeBasic kann... seit der FB Version 0.23 habe ich nicht mehr wirklich mit FB gearbeitet - und offensichtlich scheint auch das mein Problem zu sein
Ich habe ein AU3 Script mit knapp 800 Zeilen welches ich auch schon nach FB portiert habe. Bekomme auch keinerlei Kompilierungsfehler angezeigt, aber es ist dennoch fehlerhaft... Leider bin ich nicht mehr sooo familär mit der Sprache, und es hat sich anscheinend auch einiges da verändert - deswegen bekomme ich es einfach nicht hin...
Ziel ist es das die FUNKTIOSWEISE vom AU3 Script übernommen wird! Es gibt keine Gui auch keine Konsolenausgabe, es besteht aus einer Handvoll Funktionen. Wird gestartet wie ein normaler Run Aufruf, erhällt über TCP benötigte Daten, Arbeitet diese ab und sendet diese wieder über TCP zurück. Findet alles nur "Intern" statt, kein lokaes Netzwerk, kein Online.

Ich hoffe es reicht so eine waage Beschreibung... Wer sich das zutraut, bitte hier melden, bekommt natürlich weitere Infos sowie die Sourcecodes von mir incl. lauffähigen AutoIt Vorbild. Ein Zeitlimit gibt es auch nicht.

Als Belohnung gibt es eine Erwähnung in meinem Projekt.

Grüsse,
Und ich hoffe das sich einige melden

[EDIT]
Ich habe gerade übers Notebook versucht die entsprechenden Scripte hochzuladen - ABER mein lieber Sohn hat mir gestern anscheinend mein Notebook verseucht. Hab momentan nur mobiles Inet.

Techmix

Sooo, es gibt weitere Infos und die betreffenden Sourcecodes.

Allgemein:
Das Projekt entspricht einer totalen Neuauflage der 'File2Source' Kompressionsmethode CompressHEX, kurz cHEX. Durch die Tatsache das der Ursprung im Jahre 2010 liegt, dachte ich mir das ich mal eine 'erweiterte' Version erstellen sollte. Das Prinzip ist gleich, nur die Durchführung ist bis auf das mögliche Maximum ausgeweitet wurden. Ich habe sooo viel in Planung, das ich zweifel alles wirklich umsetzen zu können... Hier habe das FreeBasic Problem, anderseits noch die problematische GUI, selbst die ganzen AU3 Funktionen stehen noch nicht, und da ist auch noch eine PHP & MySQL Verwaltung nötig... Wird langsam ´ne ganze Menge.
Alles nur weil man zuviel will

Aufruf vom Hauptprogramm:
ShellExecute(@ScriptDir & "\Temp\"&$sProcess&".exe", TCPNameToIP(@ComputerName)&","&$iPort, @SW_HIDE) <- Der Source wird intern Kompiliert (bei AU3)
Es wird gestartet und die IP & Port gesendet. Wenn der Prozess läuft, Connectet dieser über TCP und erhällt Settings und seine Daten.
Diese werden abgearbeitet und anschliessend über TCP zurückgesendet.
Das Hauptprogramm empfängt diese und sendet dem Prozess ein "Exit"

AutoIt3:
Wer AU3 kann sollte eigentlich verstehen was im Prozess stattfindet...

Spoiler anzeigen

[autoit]

#Region ;**** Directives created by AutoIt3Wrapper_GUI ****
#AutoIt3Wrapper_UseUpx=n
#AutoIt3Wrapper_UseX64=n
#AutoIt3Wrapper_Res_Fileversion=0.11
#AutoIt3Wrapper_Res_LegalCopyright=by Techmix
#AutoIt3Wrapper_Res_Field=AutoIt Version|3.3.10.2
#EndRegion ;**** Directives created by AutoIt3Wrapper_GUI ****
#RequireAdmin
#include-once
#include <Array.au3>
#include <File.au3>
#include <String.au3>

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

#cs --------------------------------------------------------------------------------------------------------------------------------

[/autoit] [autoit][/autoit] [autoit]

AutoIt Version: 3.3.10.2
Script: CompressHEX-Process.au3
Progammversion: 0.11
Author: Techmix

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

Programm Funktionen:
Dieses Script soll Multiprocessing in AutoIt3 funktional präsentieren.

[/autoit] [autoit][/autoit] [autoit]

Umfang:
_CompressHEX = Methode
_HEXCrouch = Methode
_HEXAnalyse = Funktion
_HEXReplace = Funktion

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

## --------------------------------------------------------------------------------------------------------------------------------
## -Changelog:---------------------------------------------------------------------------------------------------------------------

[/autoit] [autoit][/autoit] [autoit]

V0.11
Multiprocessing Kommunikation über TCP/IP
_HEXCrouch Methode zugefügt

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

## --------------------------------------------------------------------------------------------------------------------------------

[/autoit] [autoit][/autoit] [autoit]

V0.10
Das Multiprocessing arbeitet jetzt effektiver
_CompressHEX Methode zugefügt
_HEXAnalyse Funktion verbessert
_HEXReplace Funktion verbessert

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

## --------------------------------------------------------------------------------------------------------------------------------
#ce --------------------------------------------------------------------------------------------------------------------------------

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; ----------------------------------------------------------------------------------------------------------------------------------
; Deklarationen
; ----------------------------------------------------------------------------------------------------------------------------------

[/autoit] [autoit][/autoit] [autoit]

; Allgemeine Settings
Global _
$a_Trenner[2][2], _
$a_NotReplace[1], _
$a_HEXAnalyse_Chars[1], _
$s_TcpData

[/autoit] [autoit][/autoit] [autoit]

; Globale Setting 'Flags'
Global _
$i_HEXAnalyse_Counts, _
$i_HEXAnalyse_MinReplace, _
$i_TCP_Port, _
$i_HEXCrouch_Active, _
$i_HEXAnalyse_Detail, _
$i_HEXAnalyse_Detail_0Max, _
$i_HEXAnalyse_Detail_1Max, _
$i_HEXAnalyse_Detail_2Step, _
$i_HEXAnalyse_Detail_2Size, _
$i_HEXAnalyse_MaxAuswertung, _
$i_HEXCrouch_Steps, _
$i_HEXCrouch_MinSize

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; ----------------------------------------------------------------------------------------------------------------------------------
; Processing-StartUP
; ----------------------------------------------------------------------------------------------------------------------------------

[/autoit] [autoit][/autoit] [autoit]

if @Compiled Then
if $CmdLine[0] >= 1 Then
; TCP-Verbindungen initieren
TCPStartup()
AdlibRegister("_CheckMaster", 500)

[/autoit] [autoit][/autoit] [autoit]

; TCP-Daten erhalten
Dim _
$i_TCP_Port = $CmdLine[1], _
$hSocket = TCPConnect(TCPNameToIP(@ComputerName), $i_TCP_Port), _
$sString, _
$hTimer, _
$aData, _
$sData, _
$sTcpData
Do
$sTcpData &= TCPRecv($hSocket, 2048)
Until @error
$sTcpData = BinaryToString($sTcpData)

[/autoit] [autoit][/autoit] [autoit]

; Daten auslesen
$i_HEXCrouch_Active = _GetData($sTcpData, "iHEXCrouch_Active")
$i_HEXAnalyse_Detail = _GetData($sTcpData, "iHEXAnalyse_Detail")
$i_HEXAnalyse_Detail_0Max = _GetData($sTcpData, "iHEXAnalyse_Detail_0Max")
$i_HEXAnalyse_Detail_1Max = _GetData($sTcpData, "iHEXAnalyse_Detail_1Max")
$i_HEXAnalyse_Detail_2Step = _GetData($sTcpData, "iHEXAnalyse_Detail_2Step")
$i_HEXAnalyse_Detail_2Size = _GetData($sTcpData, "iHEXAnalyse_Detail_2Size")
$i_HEXAnalyse_MaxAuswertung = _GetData($sTcpData, "iHEXAnalyse_MaxAuswertung")
$i_HEXCrouch_Steps = _GetData($sTcpData, "iHEXCrouch_Steps")
$i_HEXCrouch_MinSize = _GetData($sTcpData, "iHEXCrouch_MinSize")
$i_HEXAnalyse_Counts = _GetData($sTcpData, "iHEXAnalyse_Counts")
$i_HEXAnalyse_MinReplace = _GetData($sTcpData, "iHEXAnalyse_MinReplace")
$sString = _GetData($sTcpData, "sData")
$sData = _GetData($sTcpData, "aTrenner")
$aData = StringSplit($sData, Chr(255))
$a_Trenner[0][0] = $aData[1]
$a_Trenner[0][1] = $aData[2]
$a_Trenner[1][0] = $aData[3]
$a_Trenner[1][1] = $aData[4]
$sData = _GetData($sTcpData, "aNotReplace")
$aData = StringSplit($sData, Chr(255))
ReDim $a_NotReplace[$aData[0]]
for $i = 1 to $aData[0]
$a_NotReplace[$i-1] = $aData[$i]
Next

[/autoit] [autoit][/autoit] [autoit]

; Durchführung
$sData = _CompressHEX($sString, 0)
TCPSend($hSocket, StringToBinary($sData))

[/autoit] [autoit][/autoit] [autoit]

; Prozess und TCP beenden...
$hTimer = TimerInit()
Do
Sleep(2)
$sTcpData = TCPRecv($hSocket, 16)
Until $sTcpData = "Exit" or TimerDiff($hTimer) > 5000
TCPShutdown()
Exit
EndIf
EndIf

[/autoit] [autoit][/autoit] [autoit]

Func _GetData($sData, $sKey)
Local $aArray = StringSplit($sData, @CRLF)
for $i = 1 to $aArray[0]
if StringLeft($aArray[$i], StringLen($sKey)+1) = $sKey & ":" then Return StringReplace($aArray[$i], $sKey & ":", "")
Next
EndFunc

[/autoit] [autoit][/autoit] [autoit]

Func _CheckMaster()
if ProcessExists("AutoIt3.exe")or ProcessExists("CompressHEX.exe") Then Return
Exit
EndFunc

[/autoit] [autoit][/autoit] [autoit]

; ----------------------------------------------------------------------------------------------------------------------------------
; Funktionen aus CompressHEX Main
; ----------------------------------------------------------------------------------------------------------------------------------

[/autoit] [autoit][/autoit] [autoit]

Func _CompressHEX($sString, $iMode = -1) ; Eigentliche Hauptfunktion
Local _
$aRanking[1][2], _
$aReplaced[1][2], _
$aTemp, _
$sTemp, _
$sKey, _
$sData, _
$iStep

[/autoit] [autoit][/autoit] [autoit]

If $iMode = 0 Then ; Kompression
$iStep = 0
For $i = 0 To 999
$aRanking = _HEXAnalyse($sString, $aReplaced, $iStep) ; Beste verfügbare Replacer aussuchen
$sString = _HEXReplace($sString, $aRanking, $aReplaced) ; Replacer austauschen
If @error Then ExitLoop
if $i_HEXCrouch_Active = 1 and $iStep = 1 then $sString = _HEXCrouch($sString, $aReplaced)
$iStep = 1 - $iStep
Next
$sData = $sString & $a_Trenner[0][1]

[/autoit] [autoit][/autoit] [autoit]

; $sKey Erstellen
For $i = 0 To UBound($aReplaced, 1) - 1
If $aReplaced[$i][0] <> "" And $aReplaced[$i][1] <> "" Then $sKey &= $aReplaced[$i][0] & $a_Trenner[0][1] & $aReplaced[$i][1] & $a_Trenner[0][1]
Next
$sData &= StringTrimRight($sKey, 1)

[/autoit] [autoit][/autoit] [autoit]

ElseIf $iMode = 1 Then ; Dekompression aller Methoden!
Dim _
$aDecrypt[1], _
$aTemp

[/autoit] [autoit][/autoit] [autoit]

if StringMid($sString, 1, 1) = chr(255) and StringMid($sString, 3, 1) = chr(255) and StringMid($sString, 5, 1) = chr(255) Then $sString = StringTrimLeft($sString, 5)

[/autoit] [autoit][/autoit] [autoit]

; Sektions-Arten Festlegen
If StringInStr($sString, $a_Trenner[1][1]) Then
; Mehrfach Sektionen
$aDecrypt = StringSplit($sString, $a_Trenner[1][1], 2)
Else
; Einzel Sektion
$aDecrypt[0] = $sString
EndIf

[/autoit] [autoit][/autoit] [autoit]

$sData = "0x"
For $i = 0 To UBound($aDecrypt) - 1
$aTemp = StringSplit($aDecrypt[$i], $a_Trenner[0][1], 2)
$aDecrypt[$i] = $aTemp[0]
For $j = UBound($aTemp) - 1 To 1 Step -2
if stringlen($aTemp[$j - 1]) > 1 Then
; Crouch-Replace
$sTemp = ""
for $x = 1 to Number(StringTrimLeft($aTemp[$j - 1], 1))
$sTemp &= StringLeft($aTemp[$j - 1], 1)
Next
$aDecrypt[$i] = StringReplace($aDecrypt[$i], $aTemp[$j], $sTemp, 0, 1)
Else
; Normal Replace
$aDecrypt[$i] = StringReplace($aDecrypt[$i], $aTemp[$j - 1], $aTemp[$j], 0, 1)
EndIf
Next
$sData &= $aDecrypt[$i]
Next
EndIf

[/autoit] [autoit][/autoit] [autoit]

Return $sData

[/autoit] [autoit][/autoit] [autoit]

EndFunc
Func _HEXAnalyse($sString, ByRef $aReplaced, $iCreateArray = 0) ; Analyse Funktion
Local _
$iDetail = 0, _ ; !> Verbesserung??
$aRanking[1][2], _
$iCount, _
$sTemp, _
$iExtendet, _
$aRanking2[1][2], _
$sString2

[/autoit] [autoit][/autoit] [autoit]

; Char-Array erstellen?!
if $iCreateArray = 0 Then
ReDim $a_HEXAnalyse_Chars[16^2]
For $i = 0 to UBound($a_HEXAnalyse_Chars)-1
$a_HEXAnalyse_Chars[$i] = hex($i, 2)
Next
ElseIf $iCreateArray > 0 then
if $i_HEXAnalyse_Detail = 0 then
; Hardcore Maximum Array
dim $pool[1]
While 1
; Zufall-Pool erstellen
if UBound($pool) = 255 - 32 - UBound($a_NotReplace) then ExitLoop
Do
$sTemp = Random(32, 255, 1)
Until _ArraySearch($pool, Chr($sTemp)) = -1 ; Nicht bereits im Pool
if _ArraySearch($a_NotReplace, $sTemp) = -1 then ; Nicht auf der NICHT tauschen Liste,
$pool[UBound($pool)-1] = Chr($sTemp)
ReDim $pool[UBound($pool)+1]
EndIf
WEnd
_ArrayDelete($pool, UBound($pool)-1)
ReDim $a_HEXAnalyse_Chars[$i_HEXAnalyse_Detail_0Max] ; Auf Max-Size begrenzen - 10K Char zu 3 Zeichen sind 30MB
$iCount = 0
For $i=0 to UBound($pool)-1
For $j=0 to UBound($pool)-1
For $k=0 to UBound($pool)-1
if $iCount = UBound($a_HEXAnalyse_Chars) then ExitLoop 3
if not StringInStr($sString, $pool[$i] & $pool[$j] & $pool[$k], 1) then ContinueLoop
$a_HEXAnalyse_Chars[$iCount] = $pool[$i] & $pool[$j] & $pool[$k]
$iCount += 1
Next
Next
Next
Elseif $i_HEXAnalyse_Detail = 1 then
; Zufalls Array
ReDim $a_HEXAnalyse_Chars[$i_HEXAnalyse_Detail_1Max]
For $i = 0 to UBound($a_HEXAnalyse_Chars)-1
$a_HEXAnalyse_Chars[$i] = StringMid($sString, Random(0,StringLen($sString)-3,1), 3)
Next
$a_HEXAnalyse_Chars = _ArrayUnique($a_HEXAnalyse_Chars)
Elseif $i_HEXAnalyse_Detail = 2 then
; Zufall detaliertes Array
ReDim $a_HEXAnalyse_Chars[int((($i_HEXAnalyse_Detail_2Size / 3)+1)*$i_HEXAnalyse_Detail_2Step)]
dim _
$iSizeByte = $i_HEXAnalyse_Detail_2Size, _
$iCount = 0
for $i = 1 to $i_HEXAnalyse_Detail_2Step
For $j = Random(1,StringLen($sString)-$iSizeByte,1) to UBound($a_HEXAnalyse_Chars)-1
if $iCount = UBound($a_HEXAnalyse_Chars) then ExitLoop
$a_HEXAnalyse_Chars[$iCount] = StringMid($sString, $j, 3)
$iCount += 1
Next
Next
$a_HEXAnalyse_Chars = _ArrayUnique($a_HEXAnalyse_Chars)
EndIf
EndIf

[/autoit] [autoit][/autoit] [autoit]

if $i_HEXAnalyse_MaxAuswertung = 1 Then
$sString2 = $sString
for $y = 0 to $i_HEXAnalyse_Counts-1
; Char-Array auswerten
$iCount = 0
For $i = 0 to UBound($a_HEXAnalyse_Chars)-1
if StringInStr($sString2, $a_HEXAnalyse_Chars[$i], 1) = 0 Then ContinueLoop
if _ArraySearch($aReplaced, $a_HEXAnalyse_Chars[$i], 0,0,1,0,1, 0) = -1 then
$sTemp = StringReplace($sString2, $a_HEXAnalyse_Chars[$i], "", 0, 1)
$iExtendet = StringLen($sString2) - StringLen($sTemp) + 1
if $iExtendet > $i_HEXAnalyse_MinReplace then
ReDim $aRanking2[$iCount+1][2]
$aRanking2[$iCount][0] = $a_HEXAnalyse_Chars[$i] ; Treffer festlegen
$aRanking2[$iCount][1] = $iExtendet ; Anzahl der Treffer
$iCount+=1
EndIf
EndIf
Next
if $aRanking2[0][0] = "" then ExitLoop
_ArraySort($aRanking2, 1, 0, 0, 1) ; nach Trefferanzahl sortieren
ReDim $aRanking2[1][2]
$aRanking[UBound($aRanking, 1)-1][0] = $aRanking2[0][0] ; Treffer festlegen
$aRanking[UBound($aRanking, 1)-1][1] = $aRanking2[0][1] ; Anzahl der Treffer
ReDim $aRanking[UBound($aRanking, 1)+1][2]
$sString2 = StringReplace($sString2, $aRanking2[0][0], "", 0, 1)
Next
Else
; Char-Array auswerten
$iCount = 0
For $i = 0 to UBound($a_HEXAnalyse_Chars)-1
if StringInStr($sString, $a_HEXAnalyse_Chars[$i], 1) = 0 Then ContinueLoop
if _ArraySearch($aReplaced, $a_HEXAnalyse_Chars[$i], 0,0,1,0,1, 0) = -1 then
$sTemp = StringReplace($sString, $a_HEXAnalyse_Chars[$i], "", 0, 1)
$iExtendet = StringLen($sString) - StringLen($sTemp) + 1
if $iExtendet > $i_HEXAnalyse_MinReplace then
ReDim $aRanking[$iCount+1][2]
$aRanking[$iCount][0] = $a_HEXAnalyse_Chars[$i] ; Treffer festlegen
$aRanking[$iCount][1] = $iExtendet ; Anzahl der Treffer
$iCount+=1
EndIf
EndIf
Next

[/autoit] [autoit][/autoit] [autoit]

; Char-Array sortieren
_ArraySort($aRanking, 1, 0, 0, 1) ; nach Trefferanzahl sortieren
if UBound($aRanking, 1) > $i_HEXAnalyse_Counts then ReDim $aRanking[$i_HEXAnalyse_Counts][2]
EndIf

[/autoit] [autoit][/autoit] [autoit]

;~ _ArrayDisplay($aRanking)
if $aRanking[0][0] = "" then Return SetError(1, 0, $aRanking)
Return $aRanking

[/autoit] [autoit][/autoit] [autoit]

EndFunc
Func _HEXReplace($sString, $aRanking, ByRef $aReplaced) ; Austausch Funktion
if $aRanking[0][0] = "" then Return SetError(1, 0, $sString)
Local _
$aPool[1], _
$iCount = 0, _
$sCHR

[/autoit] [autoit][/autoit] [autoit]

; Pool erstellen
for $i = 255 to 32 step -1 ; Mögliche Replacer durchlaufen
if _ArraySearch($a_NotReplace, $i) = -1 then
$aPool[UBound($aPool)-1] = $i
ReDim $aPool[UBound($aPool)+1]
EndIf
Next
_ArrayDelete($aPool, UBound($aPool)-1)

[/autoit] [autoit][/autoit] [autoit]

for $i = UBound($aPool)-1 to 0 step -1 ; Mögliche Replacer durchlaufen
if not StringInStr($sString, $aRanking[0][0], 1) Then
if UBound($aRanking) = 1 then ExitLoop
_ArrayDelete($aRanking, 0)
ContinueLoop
EndIf

[/autoit] [autoit][/autoit] [autoit]

$sCHR = Chr($aPool[$i])
if _ArraySearch($aReplaced, $sCHR, 0,0,1,0,1, 1) = -1 and _ ; Bereits getauscht,
StringInStr($sString, $sCHR) = 0 _ ; oder noch im String vorhanden?
then
$iCount += 1
$aReplaced[UBound($aReplaced, 1)-1][0] = $sCHR
$aReplaced[UBound($aReplaced, 1)-1][1] = $aRanking[0][0]
ReDim $aReplaced[UBound($aReplaced, 1)+1][2]
$sString = StringReplace($sString, $aRanking[0][0], $sCHR)
if UBound($aRanking) = 1 then ExitLoop
_ArrayDelete($aRanking, 0)
EndIf
Next

[/autoit] [autoit][/autoit] [autoit]

if UBound($aRanking) > 1 then SetError(1, 0, $sString)
Return $sString

[/autoit] [autoit][/autoit] [autoit]

EndFunc
Func _HEXCrouch($sString, ByRef $aReplaced) ; Analyse Methode
Local _
$aRanking[1][2], _
$aCrouch[$i_HEXCrouch_Steps+1], _
$sChr, $iCount, $sTemp, $sString2, $iTemp, $aTemp[1], $aTemp2[1], $iExtendet

[/autoit] [autoit][/autoit] [autoit]

; Crouch-Array erstellen
$sString2 = $sString
for $y = 0 to $i_HEXCrouch_Steps
; Jeden Schritt detaliert durchlaufen
$iCount = 0
ReDim $aTemp[1]
ReDim $aRanking[1][2]
$aRanking[0][0] = ""

[/autoit] [autoit][/autoit] [autoit]

; Crouch-Array Daten
for $i = 1 to StringLen($sString2)
if $sChr = "" then
$sChr = StringMid($sString2, $i, 1)
$iCount = 1
ContinueLoop
EndIf
if StringMid($sString2, $i, 1) = $sChr then
$iCount += 1
Else
if $iCount >= $i_HEXCrouch_MinSize then
if _ArraySearch($aCrouch, $sChr&$iCount) = - 1 then
$sTemp = ""
for $j = 1 to $iCount
$sTemp &= $sChr
Next
$sTemp = StringReplace($sString2, $sTemp, "", 0, 1)
$iExtendet = StringLen($sString2) - StringLen($sTemp)
if $iExtendet > StringLen($sChr&$iCount)+4 then
$aTemp[UBound($aTemp)-1] = $sChr&$iCount
ReDim $aTemp[UBound($aTemp)+1]
EndIf
EndIf
EndIf
$sChr = ""
EndIf
Next
if $aTemp[0] = "" then ExitLoop

[/autoit] [autoit][/autoit] [autoit]

; Crouch-Array auswerten
if $aTemp[0] = "" then Return $sString
$iCount = 0
ReDim $aTemp2[UBound($aTemp)]
For $i = 0 to UBound($aTemp)-1
$sTemp = StringLeft($aTemp[$i], 1)
$iTemp = Number(StringTrimLeft($aTemp[$i], 1))
for $j = 1 to $iTemp
$aTemp2[$i] &= $sTemp
Next
if _ArraySearch($aReplaced, $aTemp[$i], 0,0,1,0,1, 0) = -1 then
$sTemp = StringReplace($sString2, $aTemp2[$i], "", 0, 1)
$iExtendet = StringLen($sString2) - StringLen($sTemp)
if $iExtendet > $i_HEXAnalyse_MinReplace then
ReDim $aRanking[$iCount+1][2]
$aRanking[$iCount][0] = $aTemp[$i] ; Treffer festlegen
$aRanking[$iCount][1] = $iExtendet ; Anzahl der Treffer
$iCount+=1
EndIf
EndIf
Next

[/autoit] [autoit][/autoit] [autoit]

; Crouch-Array sortieren
if $aRanking[0][0] = "" then ExitLoop
_ArraySort($aRanking, 1, 0, 0, 1) ; nach Trefferanzahl sortieren
ReDim $aRanking[1][2]
$aCrouch[$y] = $aRanking[0][0]
$sTemp = ""
for $j = 1 to Number(StringTrimLeft($aCrouch[$y], 1))
$sTemp &= StringLeft($aCrouch[$y], 1)
Next
$sString2 = StringReplace($sString2, $sTemp, "", 0, 1)
Next

[/autoit] [autoit][/autoit] [autoit]

; Crouch 2 Ranking
for $y = 0 to $i_HEXAnalyse_Counts-1
if $aCrouch[$y] <> "" then
ReDim $aRanking[$y+1][2]
$sTemp = ""
for $j = 1 to Number(StringTrimLeft($aCrouch[$y], 1))
$sTemp &= StringLeft($aCrouch[$y], 1)
Next
$aRanking[$y][0] = $sTemp
EndIf
Next

[/autoit] [autoit][/autoit] [autoit]

; Crouch-Array tauschen
$iCount = 0
for $i = 255 to 32 step -1 ; Mögliche Replacer durchlaufen
if not StringInStr($sString, $aRanking[0][0], 1) Then
if UBound($aRanking) = 1 then ExitLoop
_ArrayDelete($aRanking, 0)
_ArrayDelete($aCrouch, 0)
ContinueLoop
EndIf

[/autoit] [autoit][/autoit] [autoit]

$sCHR = Chr($i)
if _ArraySearch($a_NotReplace, $i) = -1 and _ ; oder auf der NICHT tauschen Liste,
StringInStr($sString, $sCHR) = 0 _ ; oder noch im String vorhanden?
then
$iCount += 1
$aReplaced[UBound($aReplaced, 1)-1][0] = $aCrouch[0]
$aReplaced[UBound($aReplaced, 1)-1][1] = $sCHR
ReDim $aReplaced[UBound($aReplaced, 1)+1][2]
$sString = StringReplace($sString, $aRanking[0][0], $sCHR)
if UBound($aRanking) = 1 then ExitLoop
_ArrayDelete($aRanking, 0)
_ArrayDelete($aCrouch, 0)
EndIf
Next

[/autoit] [autoit][/autoit] [autoit]

Return $sString

[/autoit] [autoit][/autoit] [autoit]

EndFunc

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit]

FreeBasic:
Bei FreeBasic habe ich mich entschieden bei dem Multiprocessing (wie in AU3) zu bleiben, einfach weil mein Grundkonzept darauf ausgelegt ist. So erreiche eine hohe Kompitabilität.
Mit den gegebenen TCP-Funktionen habe ich mich sehr schwer getan, und entschied mich für die 'TSNE_V3' (weil es in den Beispielen einfach aussieht) ABER ich bekomme es auch damit nicht Funktionstüchtig - lässt sich nichtmals Kompilieren... <- Vielleicht nicht kompitabel zur verwendeten FB Version?!?!?
Es sind noch einige Funktionen nicht fertiggestellt, z.B: die Adlib Funktionen - ich versuchte mich AU3 anzulehnen, läuft wahrscheinlich auch nicht wie gewünscht.
Ich habe einige weitere Funktionen im AU3-Style Gewrappt, alles im totalen Blindflug! Dadurch das es sich nicht kompilieren lässt - kann ich auch nicht Testen....
Warum FreeBasic? Ich habe mich für den zusätzlichen Prozess in FB aus vielen Gründen entschieden, einer ist die Geschwindigkeit (höher als in C), ein weiterer ist das es eine ähnliche 'Niesche' wie AutoIt belegt.
Optimierungen?? Diese werden mit Kusshand entgegengenommen, hauptsache der Funktionsaufruf im Main bleibt gültig! Keine DLL erstellung!! Ich weiß nicht genau welche Kompiler-Flags für diesen Einsatz nütlich wären, auch halte ich InLine-ASM für sehr nütlich (bereits eine Funktion enthalten).
Es wird noch die 'TSNE_V3.bi' benötigt.

Spoiler anzeigen

[autoit]

#include "TSNE_V3.bi"

[/autoit] [autoit][/autoit] [autoit]

'~ using TSNE_V3

[/autoit] [autoit][/autoit] [autoit]

'~ --------------------------------------------------------------------------------------------------------------------------------
'~
'~ FreeBasic Version: 0.90.1
'~ Script: CompressHEX-Process.bas
'~ Progammversion: 0.10
'~ Author: Techmix
'~
'~
'~ Programm Funktionen:
'~ Dieses FB Programm interpretiert den AU3-Prozess.
'~
'~ Umfang:
'~ _CompressHEX = Methode
'~ _HEXCrouch = Methode
'~ _HEXAnalyse = Funktion
'~ _HEXReplace = Funktion
'~
'~
'~ --------------------------------------------------------------------------------------------------------------------------------
'~ -Changelog:---------------------------------------------------------------------------------------------------------------------
'~
'~ V0.10
'~ Das Multiprocessing arbeitet jetzt effektiver
'~ Multiprocessing Kommunikation über TCP/IP
'~ _CompressHEX Methode zugefügt
'~ _HEXAnalyse Funktion verbessert
'~ _HEXReplace Funktion verbessert
'~ _HEXCrouch Methode zugefügt
'~
'~
'~ --------------------------------------------------------------------------------------------------------------------------------
'~ --------------------------------------------------------------------------------------------------------------------------------

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

' ---------------------------------------------------------------------------------------------------------------------------------
' Deklarationen
' ---------------------------------------------------------------------------------------------------------------------------------

[/autoit] [autoit][/autoit] [autoit]

' Allgemeine Settings
Dim Shared As Integer _
a_NotReplace(), _
a_AdlibTime()
Dim Shared As Sub _
a_AdlibRegister()
Dim Shared As String _
a_HEXAnalyse_Chars(), _
a_Trenner(0 to 1, 0 to 1), _
s_TcpData, _
CRLF
CRLF = Chr(13, 10)

[/autoit] [autoit][/autoit] [autoit]

' Globale Setting 'Flags'
Dim Shared As Integer _
i_HEXAnalyse_Counts, _
i_HEXAnalyse_MinReplace, _
i_HEXAnalyse_ClusterSize, _
i_HEXAnalyse_Detail, _
i_HEXAnalyse_Detail_0Max, _
i_HEXAnalyse_Detail_1Max, _
i_HEXAnalyse_Detail_2Size, _
i_HEXAnalyse_Detail_2Step, _
i_HEXAnalyse_MaxAuswertung, _
i_HEXCrouch_Active, _
i_HEXCrouch_MinSize, _
i_HEXCrouch_Steps

[/autoit] [autoit][/autoit] [autoit]

' Haupt- und Unterfunktionen
Declare Function _GetData (sData as String, sKey as String) as String
Declare Function _CompressHEX (sString as String, iMode As Integer = -1) as String
Declare Function _HEXAnalyse (sString as String, aRanking() as String, aReplaced() as String, iCreateArray As Integer = 0) as Integer
Declare Function _HEXReplace (ByRef sString as String, aRanking() as String, aReplaced() as String) as Integer
Declare Function _HEXCrouch (sString as String, aReplaced() as String) as String
Declare Sub _CheckMaster ()
Declare Function ASM_Replace (TiStr As String, TiFind As String, TiRep As String) As String
Declare Sub StringSplit (sString As String, sDelimiter As String, aReturn() As String)

[/autoit] [autoit][/autoit] [autoit]

' TCP Deklarationen
Declare Sub TSNE_Disconnected (ByVal V_TSNEID as UInteger)
Declare Sub TSNE_Connected (ByVal V_TSNEID as UInteger)
Declare Sub TSNE_NewData (ByVal V_TSNEID as UInteger, ByRef V_Data as String)

[/autoit] [autoit][/autoit] [autoit]

' AutoIt3 Wrapper Func´s
Declare Sub AdlibRegister (sFunction as Sub, iTime As Integer)
Declare Sub AdlibUnRegister (sFunction as Sub)
Declare Sub AdlibEmpty ()
Declare Function TimerInit () As Integer
Declare Function TimerDiff (iTimerInit As Integer) As Integer
Declare Function ProcessExists (sProcessName as String) As Integer
Declare Function StringLen (sString as String) As Integer
Declare Function StringLeft (sString as String, iLen As Integer) As String
Declare Function StringMid (sString as String, iStart As Integer, iLen As Integer) As String
Declare Function StringRight (sString as String, iLen As Integer) As String
Declare Function StringTrimLeft (sString as String, iLen As Integer) As String
Declare Function StringTrimRight(sString as String, iLen As Integer) As String
Declare Function BinaryToString (sString as String) As String
Declare Function StringToBinary (sString as String) As String
Declare Function _ArraySearch_S (aArray() as String, sValue as String) As Integer
Declare Function _ArraySearch_I (aArray() as Integer, sValue as Integer) As Integer
Declare Sub _ArrayUnique_S (aArray() as String)
Declare Sub _ArrayUnique_I (aArray() as Integer)
Declare Sub _ArrayDelete_S (aArray() as String, iIndex as Integer)
Declare Sub _ArrayDelete_I (aArray() as Integer, iIndex as Integer)
Declare Sub _ArraySort (aArray() as String, iDimension as Integer = 0)
Declare Function _Random_I (iMin As Integer, iMax As Integer) As Integer
Declare Function _Random_D (iMin As Double, iMax As Double) As Double

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

' ---------------------------------------------------------------------------------------------------------------------------------
' Processing-StartUP
' ---------------------------------------------------------------------------------------------------------------------------------

[/autoit] [autoit][/autoit] [autoit]

Dim As String _
sString, _
aData(), _
sData, _
sTcpData, _
sTCP, _
aTCP()
Dim As Integer _
i, _
hTimer
Dim As String i_TCP_IP ' IP Adresse
Dim As UShort i_TCP_Port ' Port
Dim As UInteger hSocket ' TCP Handle

[/autoit] [autoit][/autoit] [autoit]

' TCP-Daten erhalten
sTCP = Command(1)
StringSplit(sTCP, ",", aTCP())
i_TCP_IP = aTCP(0)
i_TCP_Port = VAL(aTCP(1))
AdlibRegister(@_CheckMaster, 500)

[/autoit] [autoit][/autoit] [autoit]

' TCP-Verbindungen initieren
TSNE_Create_Client(hSocket, i_TCP_IP, i_TCP_Port, @TSNE_Disconnected, @TSNE_Connected, @TSNE_NewData, 15)
TSNE_NewData(hSocket, sTcpData)

[/autoit] [autoit][/autoit] [autoit]

print sTcpData

[/autoit] [autoit][/autoit] [autoit]

' Daten auslesen
i_HEXCrouch_Active = VAL(_GetData(sTcpData, "iHEXCrouch_Active"))
i_HEXAnalyse_Detail = VAL(_GetData(sTcpData, "iHEXAnalyse_Detail"))
i_HEXAnalyse_Detail_0Max = VAL(_GetData(sTcpData, "iHEXAnalyse_Detail_0Max"))
i_HEXAnalyse_Detail_1Max = VAL(_GetData(sTcpData, "iHEXAnalyse_Detail_1Max"))
i_HEXAnalyse_Detail_2Step = VAL(_GetData(sTcpData, "iHEXAnalyse_Detail_2Step"))
i_HEXAnalyse_Detail_2Size = VAL(_GetData(sTcpData, "iHEXAnalyse_Detail_2Size"))
i_HEXAnalyse_MaxAuswertung = VAL(_GetData(sTcpData, "iHEXAnalyse_MaxAuswertung"))
i_HEXCrouch_Steps = VAL(_GetData(sTcpData, "iHEXCrouch_Steps"))
i_HEXCrouch_MinSize = VAL(_GetData(sTcpData, "iHEXCrouch_MinSize"))
i_HEXAnalyse_Counts = VAL(_GetData(sTcpData, "iHEXAnalyse_Counts"))
i_HEXAnalyse_MinReplace = VAL(_GetData(sTcpData, "iHEXAnalyse_MinReplace"))
sString = _GetData(sTcpData, "sData")
sData = _GetData(sTcpData, "aTrenner")
StringSplit(sData, Chr(255), aData())
a_Trenner(0,0) = aData(1)
a_Trenner(0,1) = aData(2)
a_Trenner(1,0) = aData(3)
a_Trenner(1,1) = aData(4)
sData = _GetData(sTcpData, "aNotReplace")
StringSplit(sData, Chr(255), aData())
ReDim a_NotReplace(0 to UBound(aData)-1)
for i = 1 to UBound(a_NotReplace) -1
a_NotReplace(i-1) = Val(aData(i))
Next

[/autoit] [autoit][/autoit] [autoit]

' Durchführung

[/autoit] [autoit][/autoit] [autoit]

print sString
sData = _CompressHEX(sString, 0)
TSNE_Data_Send(hSocket, StringToBinary(sData))
print sData

[/autoit] [autoit][/autoit] [autoit]

' Prozess und TCP beenden...
hTimer = TimerInit()
sTcpData = ""
Do
Sleep 1
TSNE_NewData(hSocket, sTcpData)
Loop Until sTcpData = "Exit" or TimerDiff(hTimer) > 5000

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

Function _GetData(sData as String, sKey as String) as String
Dim As Integer i
Dim As String _
aArray(), _
sString, _
sSplit = CRLF

[/autoit] [autoit][/autoit] [autoit]

StringSplit(sData, sSplit, aArray())
for i = 0 to UBound(aArray)-1
sString = aArray(i)
if StringLeft(sString, StringLen(sKey)+1) = sKey & ":" then exit for
Next
'~ Replace(sString, sKey & ":", "")
sString = ASM_Replace(sString, sKey & ":", "")
Return sString

[/autoit] [autoit][/autoit] [autoit]

End Function

[/autoit] [autoit][/autoit] [autoit]

Sub _CheckMaster()
'~ if not ProcessExists("AutoIt3.exe") or not ProcessExists("CompressHEX.exe") Then Exit Sub
'~ Exit
End Sub

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

' ---------------------------------------------------------------------------------------------------------------------------------
' Funktionen aus CompressHEX Main
' ---------------------------------------------------------------------------------------------------------------------------------

[/autoit] [autoit][/autoit] [autoit]

Function _CompressHEX(sString as String, iMode As Integer = -1) as String
Dim As String _
sKey, _
sData, _
aRanking(1, 2), _
aReplaced(1, 2)
Dim As Integer _
i, _
iStep

[/autoit] [autoit][/autoit] [autoit]

iStep = 0
For i = 0 To 999
If _HEXAnalyse(sString, aRanking(), aReplaced(), iStep) = -1 then Exit For ' Beste verfügbare Replacer aussuchen
If _HEXReplace(sString, aRanking(), aReplaced()) = -1 then Exit For ' Replacer austauschen
if i_HEXCrouch_Active = 1 andalso iStep = 1 then sString = _HEXCrouch(sString, aReplaced())
iStep = 1 - iStep
Next
sData = sString & a_Trenner(0, 1)

[/autoit] [autoit][/autoit] [autoit]

' sKey Erstellen
For i = 0 To UBound(aReplaced, 1) - 1
If aReplaced(i, 0) <> "" And aReplaced(i, 1) <> "" Then sKey &= aReplaced(i, 0) & a_Trenner(0, 1) & aReplaced(i, 1) & a_Trenner(0, 1)
Next
sData &= StringTrimRight(sKey, 1)

[/autoit] [autoit][/autoit] [autoit]

Return sData

[/autoit] [autoit][/autoit] [autoit]

End Function
Function _HEXAnalyse(sString as String, aRanking() as String, aReplaced() as String, iCreateArray As Integer = 0) as Integer
Dim As String _
sTemp, _
aRanking2(), _
sString2
Dim As Integer _
iSizeByte, _
iCount, _
iExtendet, _
pool(), _
i, _
j, _
k

[/autoit] [autoit][/autoit] [autoit]

' Char-Array erstellen?!
if iCreateArray = 0 Then
ReDim a_HEXAnalyse_Chars(0 to 16^2)
For i = 0 to UBound(a_HEXAnalyse_Chars)-1
a_HEXAnalyse_Chars(i) = hex(i, 2)
Next
ElseIf iCreateArray > 0 then
if i_HEXAnalyse_Detail = 0 then
' Hardcore Maximum Array
While 1
' Zufall-Pool erstellen
if UBound(pool) = 255 - 32 - UBound(a_NotReplace) then Exit While
Do
sTemp = Str(_Random_I(32, 255))
Loop Until _ArraySearch_I(pool(), Val(sTemp)) = -1 ' Nicht bereits im Pool
if _ArraySearch_I(a_NotReplace(), Val(sTemp)) = -1 then ' Nicht auf der NICHT tauschen Liste,
pool(UBound(pool)-1) = Val(sTemp)
ReDim Preserve pool(0 to UBound(pool)+1)
EndIf
WEnd
_ArrayDelete_I(pool(), UBound(pool)-1)
ReDim a_HEXAnalyse_Chars(0 to i_HEXAnalyse_Detail_0Max) ' Auf Max-Size begrenzen
iCount = 0
For i=0 to UBound(pool)-1
For j=0 to UBound(pool)-1
For k=0 to UBound(pool)-1
if iCount = UBound(a_HEXAnalyse_Chars) then Exit for, for, for
if not InStr(sString, Str(pool(i)) & Str(pool(j)) & Str(pool(k))) then Continue for
a_HEXAnalyse_Chars(iCount) = Str(pool(i)) & Str(pool(j)) & Str(pool(k))
iCount += 1
Next
Next
Next

[/autoit] [autoit][/autoit] [autoit]

Elseif i_HEXAnalyse_Detail = 1 then
' Zufalls Array
ReDim a_HEXAnalyse_Chars(0 to i_HEXAnalyse_Detail_1Max)
For i = 0 to UBound(a_HEXAnalyse_Chars)-1
a_HEXAnalyse_Chars(i) = StringMid(sString, _Random_I(0,StringLen(sString)-3), 1)
Next
_ArrayUnique_S(a_HEXAnalyse_Chars())

[/autoit] [autoit][/autoit] [autoit]

Elseif i_HEXAnalyse_Detail = 2 then
' Zufall detaliertes Array
ReDim a_HEXAnalyse_Chars(0 to int(((i_HEXAnalyse_Detail_2Size / 3)+1)*i_HEXAnalyse_Detail_2Step))
iSizeByte = i_HEXAnalyse_Detail_2Size
iCount = 0
for i = 1 to i_HEXAnalyse_Detail_2Step
For j = _Random_I(1,StringLen(sString)-iSizeByte) to UBound(a_HEXAnalyse_Chars)-1
if iCount = UBound(a_HEXAnalyse_Chars) then Exit for
a_HEXAnalyse_Chars(iCount) = StringMid(sString, j, 3)
iCount += 1
Next
Next
_ArrayUnique_S(a_HEXAnalyse_Chars())
EndIf
EndIf

[/autoit] [autoit][/autoit] [autoit]

if i_HEXAnalyse_MaxAuswertung = 1 Then
sString2 = sString
for i = 0 to i_HEXAnalyse_Counts-1
' Char-Array auswerten
iCount = 0
For i = 0 to UBound(a_HEXAnalyse_Chars)-1
if InStr(sString2, a_HEXAnalyse_Chars(j)) = 0 Then Continue for
if _ArraySearch_S(aReplaced(), a_HEXAnalyse_Chars(j)) = -1 then
'~ sTemp = sString2
'~ Replace(sTemp, str(a_HEXAnalyse_Chars(j)), "")
sTemp = ASM_Replace(sString2, str(a_HEXAnalyse_Chars(j)), "")
iExtendet = StringLen(sString2) - StringLen(sTemp) + 1
if iExtendet > i_HEXAnalyse_MinReplace then
ReDim aRanking2(0 to iCount+1, 0 to 1)
aRanking2(iCount, 0) = a_HEXAnalyse_Chars(j) ' Treffer festlegen
aRanking2(iCount, 1) = str(iExtendet) ' Anzahl der Treffer
iCount+=1
EndIf
EndIf
Next
if aRanking2(0, 0) = "" then Exit for
_ArraySort(aRanking2(), 1) ' nach Trefferanzahl sortieren
ReDim aRanking2(0 to 1, 0 to 1)
aRanking(UBound(aRanking, 1)-1, 0) = aRanking2(0, 0) ' Treffer festlegen
aRanking(UBound(aRanking, 1)-1, 1) = aRanking2(0, 1) ' Anzahl der Treffer
ReDim aRanking(0 to UBound(aRanking, 1)+1, 0 to 1)
'~ Replace(sString2, aRanking2(0, 0), "")
sString2 = ASM_Replace(sString2, aRanking2(0, 0), "")
Next
Else
' Char-Array auswerten
iCount = 0
For i = 0 to UBound(a_HEXAnalyse_Chars)-1
if InStr(sString, a_HEXAnalyse_Chars(i)) = 0 Then Continue for
if _ArraySearch_S(aReplaced(), a_HEXAnalyse_Chars(i)) = -1 then
'~ sTemp = sString
'~ Replace(sTemp, a_HEXAnalyse_Chars(i), "")
sTemp = ASM_Replace(sString, a_HEXAnalyse_Chars(i), "")
iExtendet = StringLen(sString) - StringLen(sTemp) + 1
if iExtendet > i_HEXAnalyse_MinReplace then
ReDim aRanking(0 to iCount+1, 0 to 1)
aRanking(iCount, 0) = a_HEXAnalyse_Chars(i) ' Treffer festlegen
aRanking(iCount, 1) = str(iExtendet) ' Anzahl der Treffer
iCount+=1
EndIf
EndIf
Next

[/autoit] [autoit][/autoit] [autoit]

' Char-Array sortieren
_ArraySort(aRanking(), 1) ' nach Trefferanzahl sortieren
if UBound(aRanking, 1) > i_HEXAnalyse_Counts then ReDim aRanking(0 to i_HEXAnalyse_Counts, 0 to 1)
EndIf

[/autoit] [autoit][/autoit] [autoit]

if aRanking(0, 0) = "" then Return -1
Return 1

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

End Function
Function _HEXReplace(ByRef sString as String, aRanking() as String, aReplaced() as String) as Integer
Dim As String _
sCHR
Dim As Integer _
iCount, _
aPool(), _
i

[/autoit] [autoit][/autoit] [autoit]

if aRanking(0, 0) = "" then Return -1

[/autoit] [autoit][/autoit] [autoit]

' Pool erstellen
iCount = 0
for i = 255 to 32 step -1 ' Mögliche Replacer durchlaufen
if _ArraySearch_I(a_NotReplace(), i) = -1 then
ReDim Preserve aPool(0 to iCount)
aPool(iCount) = i
iCount += 1
EndIf
Next

[/autoit] [autoit][/autoit] [autoit]

iCount = 0
for i = UBound(aPool)-1 to 0 step -1 ' Mögliche Replacer durchlaufen
if not InStr(sString, aRanking(0, 0)) Then
if UBound(aRanking) = 0 then Exit for
_ArrayDelete_S(aRanking(), 0)
Continue for
EndIf

[/autoit] [autoit][/autoit] [autoit]

sCHR = Chr(aPool(i))
if _ArraySearch_S(aReplaced(), sCHR) = -1 andalso _ ' Bereits getauscht,
InStr(sString, sCHR) = 0 _ ' oder noch im String vorhanden?
then
iCount += 1
aReplaced(UBound(aReplaced, 1)-1, 0) = sCHR
aReplaced(UBound(aReplaced, 1)-1, 1) = aRanking(0, 0)
ReDim aReplaced(UBound(aReplaced, 1)+1, 2)
'~ Replace(sString, aRanking(0, 0), sCHR)
sString = ASM_Replace(sString, aRanking(0, 0), sCHR)
if UBound(aRanking) = 1 then Exit for
_ArrayDelete_S(aRanking(), 0)
EndIf
Next

[/autoit] [autoit][/autoit] [autoit]

if UBound(aRanking) > 1 then Return -1
Return 1

[/autoit] [autoit][/autoit] [autoit]

End Function
Function _HEXCrouch(sString as String, aReplaced() as String) as String
Dim As String _
aCrouch(i_HEXCrouch_Steps+1), _
aRanking(), _
aTemp(), _
aTemp2(), _
sString2, _
sTemp, _
sTemp2, _
sChr
Dim As Integer _
iExtendet, _
iTemp, _
iCount, _
aPool(), _
i, _
j, _
y

[/autoit] [autoit][/autoit] [autoit]

' Crouch-Array erstellen
sString2 = sString
for y = 0 to i_HEXCrouch_Steps
' Jeden Schritt detaliert durchlaufen
iCount = 0
ReDim aTemp(0)
ReDim aRanking(0 to 0, 0 to 1)
aRanking(0, 0) = ""

[/autoit] [autoit][/autoit] [autoit]

' Crouch-Array Daten
for i = 1 to StringLen(sString2)
if sChr = "" then
sChr = StringMid(sString2, i, 1)
iCount = 1
Continue for
EndIf
if StringMid(sString2, i, 1) = sChr then
iCount += 1
Else
if iCount >= i_HEXCrouch_MinSize then
if _ArraySearch_S(aCrouch(), sChr & str(iCount)) = - 1 then
sTemp = ""
for j = 1 to iCount
sTemp &= sChr
Next
'~ sTemp2 = sString2
'~ Replace(sTemp2, sTemp, "")
sTemp2 = ASM_Replace(sString2, sTemp, "")
iExtendet = StringLen(sString2) - StringLen(sTemp)
if iExtendet > StringLen(sChr & str(iCount))+4 then
aTemp(UBound(aTemp)-1) = sChr & str(iCount)
ReDim Preserve aTemp(0 to UBound(aTemp)+1)
EndIf
EndIf
EndIf
sChr = ""
EndIf
Next
if aTemp(0) = "" then Exit for

[/autoit] [autoit][/autoit] [autoit]

' Crouch-Array auswerten
if aTemp(0) = "" then Return sString
iCount = 0
ReDim Preserve aTemp2(0 to UBound(aTemp))
For i = 0 to UBound(aTemp)-1
sTemp = StringLeft(aTemp(i), 1)
iTemp = Val(StringTrimLeft(aTemp(i), 1))
for j = 1 to iTemp
aTemp2(i) &= sTemp
Next
if _ArraySearch_S(aReplaced(), aTemp(i)) = -1 then
'~ Replace(sString2, aTemp2(i), "")
sString2 = ASM_Replace(sString2, aTemp2(i), "")
iExtendet = StringLen(sString2) - StringLen(sTemp)
if iExtendet > i_HEXAnalyse_MinReplace then
ReDim Preserve aRanking(0 to iCount+1, 0 to 1)
aRanking(iCount, 0) = aTemp(i) ' Treffer festlegen
aRanking(iCount, 1) = str(iExtendet) ' Anzahl der Treffer
iCount+=1
EndIf
EndIf
Next

[/autoit] [autoit][/autoit] [autoit]

' Crouch-Array sortieren
if aRanking(0, 0) = "" then Exit for
_ArraySort(aRanking(), 1) ' nach Trefferanzahl sortieren
ReDim Preserve aRanking(0 to 0, 0 to 1)
aCrouch(y) = aRanking(0, 0)
sTemp = ""
for j = 1 to Val(StringTrimLeft(aCrouch(y), 1))
sTemp &= StringLeft(aCrouch(y), 1)
Next
'~ Replace(sString2, sTemp, "")
sString2 = ASM_Replace(sString2, sTemp, "")
Next

[/autoit] [autoit][/autoit] [autoit]

' Crouch 2 Ranking
for y = 0 to i_HEXAnalyse_Counts-1
if aCrouch(y) <> "" then
ReDim Preserve aRanking(0 to y+1, 0 to 1)
sTemp = ""
for j = 1 to Val(StringTrimLeft(aCrouch(y), 1))
sTemp &= StringLeft(aCrouch(y), 1)
Next
aRanking(y, 0) = sTemp
EndIf
Next

[/autoit] [autoit][/autoit] [autoit]

' Crouch-Array tauschen
iCount = 0
for i = 255 to 32 step -1 ' Mögliche Replacer durchlaufen
if not instr(sString, aRanking(0, 0)) Then
if UBound(aRanking) = 1 then Exit for
_ArrayDelete_S(aRanking(), 0)
_ArrayDelete_S(aCrouch(), 0)
Continue for
EndIf

[/autoit] [autoit][/autoit] [autoit]

sCHR = Chr(i)
if _ArraySearch_I(a_NotReplace(), i) = -1 andalso _ ' oder auf der NICHT tauschen Liste,
InStr(sString, sCHR) = 0 _ ' oder noch im String vorhanden?
then
iCount += 1
aReplaced(UBound(aReplaced, 1)-1, 0) = aCrouch(0)
aReplaced(UBound(aReplaced, 1)-1, 1) = sCHR
ReDim Preserve aReplaced(0 to UBound(aReplaced, 1)+1, 0 to 1)
'~ Replace(sString, aRanking(0, 0), sCHR)
sString = ASM_Replace(sString, aRanking(0, 0), sCHR)
if UBound(aRanking) = 1 then Exit for
_ArrayDelete_S(aRanking(), 0)
_ArrayDelete_S(aCrouch(), 0)
EndIf
Next

[/autoit] [autoit][/autoit] [autoit]

Return sString

[/autoit] [autoit][/autoit] [autoit]

End Function

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

' ---------------------------------------------------------------------------------------------------------------------------------
' Helper-Funktionen
' ---------------------------------------------------------------------------------------------------------------------------------

[/autoit] [autoit][/autoit] [autoit]

Function ASM_Replace(TiStr As String, TiFind As String, TiRep As String) As String
Dim As ZString Ptr iStr, iFind, iRep
Dim As Integer icor= 0
Dim As Integer i, code

[/autoit] [autoit][/autoit] [autoit]

If TiStr="" Or TiFind="" Or instr(TiStr, TiFind) = 0 Then
return TiStr
EndIf
If TiRep="" Then
TiRep="¿"
icor=1
EndIf
iStr = StrPtr(TiStr)
iFind = StrPtr(TiFind)
iRep = StrPtr(TiRep)

[/autoit] [autoit][/autoit] [autoit]

Dim As Integer iSize=Len(TiStr)-Len(TiFind)
Dim As ZString Ptr dStr=CAllocate(Len(TiStr)*20)
Dim As String s

[/autoit] [autoit][/autoit] [autoit]

Asm
mov esi,[iStr]
add [iSize],esi
mov ebx,[iFind]
inc dword Ptr[iSize]
mov edi,[dStr]
End Asm
Asm Sub esi,1
Asm
jmp Start1
Start2: add esi,ecx
Start1: add esi,1
cmp [iSize],esi
jle Done
movzx eax,Byte Ptr[esi]
cmp al,[ebx]
je Match
mov [edi],al
add edi,1
jmp Start1
Match: mov ecx,-1
mov edx,ebx
B1: add ecx,1
movzx eax,Byte Ptr[edx]
Test eax,eax
jz Change
add edx,1
cmp [esi+ecx],al
je B1
movzx eax,Byte Ptr[esi]
mov [edi],al
add edi,1
jmp Start1
Change: mov edx,[iRep]
End Asm
saute: Asm Sub ecx,1
Asm
B2: movzx eax,Byte Ptr[edx]
Test eax,eax
jz Start2
add edx,1
mov [edi],al
add edi,1
jmp B2
Done: mov ecx,-1
B3: add ecx,1
movzx eax,Byte Ptr[esi+ecx]
mov [edi+ecx],al
Test eax,eax
jnz B3
'~ mov eax,[dStr]
'~ mov [toto],eax
End Asm
s=*dStr
If icor=0 Then
Deallocate dStr
return s
EndIf

[/autoit] [autoit][/autoit] [autoit]

code=Asc("¿") ' change it here if you want
asm
mov esi, [dStr]
mov edx, -1 '' "get" pointer
Xor ecx, ecx '' "put" pointer
Test esi, esi '' in case passed null string
jz 1f
0:
inc edx
movzx eax, Byte Ptr [esi+edx]
Test eax, eax
jz 1f
cmp eax,[code] '
je 0b
mov [esi+ecx], al
inc ecx
jmp 0b
1:
mov [i], ecx
End Asm
s=Left$(*dStr,i)
Deallocate dStr
return s
End Function
Sub StringSplit(sString As String, sDelimiter As String, aReturn() As String)
Dim As String _
sTmpChar, _
sTmpString
Dim As Integer _
i, _
j, _
x, _
y, _
iCount
ReDim aReturn(0 to 0)

[/autoit] [autoit][/autoit] [autoit]

iCount = -1
for i = 1 to StringLen(sString)
sTmpChar = mid(sString, i, 1)
if sTmpChar = sDelimiter or i = len(sString) then
if sTmpString <> "" then
iCount += 1

[/autoit] [autoit][/autoit] [autoit]

'
if instr(sTmpString, sDelimiter) then
y=1
sTmpChar=""
if y <= len(sTmpString) then
for x = y to len(sTmpString)
if mid(sTmpString, x, 1) = sDelimiter then
y += x
exit for
EndIf
sTmpChar &= mid(sTmpString, x, 1)
next
EndIf
if sTmpChar <> "" then
redim PRESERVE aReturn(0 to iCount)
aReturn(iCount) = sTmpChar
EndIf
else
redim PRESERVE aReturn(0 to iCount)
aReturn(iCount) = sTmpString
EndIf
sTmpString = ""

[/autoit] [autoit][/autoit] [autoit]

EndIf
else
if sTmpChar <> "" then sTmpString &= sTmpChar
EndIf
next

[/autoit] [autoit][/autoit] [autoit]

end Sub

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

' ---------------------------------------------------------------------------------------------------------------------------------
' AutoIt3 Wrapper-Funktionen
' ---------------------------------------------------------------------------------------------------------------------------------

[/autoit] [autoit][/autoit] [autoit]

' AdLib Funktionen, nutzen a_AdlibRegister und a_AdlibTime als Globale Speicher-Array
Sub AdlibRegister(sFunction as Sub, iTime As Integer)
Dim As Integer i
' Array überprüfen
if UBound(a_AdlibRegister) > 0 Then
for i = 0 to UBound(a_AdlibRegister) -1
if a_AdlibRegister(i) = sFunction Then
' Funktion bereits vorhanden, Löschen und Neustarten
AdlibUnRegister(sFunction)
AdlibRegister(sFunction, iTime)
Exit For
EndIf
Next
EndIf

[/autoit] [autoit][/autoit] [autoit]

if UBound(a_AdlibRegister, 1) = 0 Then
' Array noch Leer, Ersteintrag
ReDim _
a_AdlibRegister(0 to 0), _
a_AdlibTime(0 to 0)
a_AdlibRegister(0) = sFunction
a_AdlibTime(0) = iTime
Else
' Folgeeinträge im Array
ReDim PRESERVE _
a_AdlibRegister(0 to UBound(a_AdlibRegister, 1)+1), _
a_AdlibTime(0 to UBound(a_AdlibRegister)+1)
a_AdlibRegister(UBound(a_AdlibRegister)-1) = sFunction
a_AdlibTime(UBound(a_AdlibRegister)-1) = iTime
EndIf

[/autoit] [autoit][/autoit] [autoit]

End Sub
Sub AdlibUnRegister(sFunction as Sub)
Dim As Integer i
' Array überprüfen
if UBound(a_AdlibRegister) > 0 Then
for i = 0 to UBound(a_AdlibRegister) -1
if a_AdlibRegister(i) = sFunction then
' Funktion vorhanden, Löschen

[/autoit] [autoit][/autoit] [autoit]

'~ a_AdlibRegister(i) = __Empty()
a_AdlibTime(i) = -1
EndIf
Next
EndIf

[/autoit] [autoit][/autoit] [autoit]

End Sub
Sub AdlibEmpty()
end Sub
Function ProcessExists(sProcessName as String) As Integer

[/autoit] [autoit][/autoit] [autoit]

End Function

[/autoit] [autoit][/autoit] [autoit]

' Timer Funktionen
Function TimerInit() As Integer

[/autoit] [autoit][/autoit] [autoit]

End Function
Function TimerDiff(iTimerInit As Integer) As Integer

[/autoit] [autoit][/autoit] [autoit]

End Function

[/autoit] [autoit][/autoit] [autoit]

Function _Random_I(iMin As Integer, iMax As Integer) As Integer
RANDOMIZE iMin, 3
Return INT(RND * iMax) + 1

[/autoit] [autoit][/autoit] [autoit]

End Function
Function _Random_D(iMin As Double, iMax As Double) As Double
RANDOMIZE iMin, 3
Return RND * iMax + 1

[/autoit] [autoit][/autoit] [autoit]

End Function

[/autoit] [autoit][/autoit] [autoit]

Function BinaryToString(sString as String) As String
'~ Return Bin2Hex(sString)
'~ Return VALINT("&h"&sString)
End Function
Function StringToBinary(sString as String) As String
'~ Return Bin2Hex(sString)
'~ Return Bin2Hex(sString)
End Function

[/autoit] [autoit][/autoit] [autoit]

' Array Funktionen
Function _ArraySearch_S(aArray() as String, sValue as String) As Integer
Dim As Integer i
for i = 0 to UBound(aArray) -1
if aArray(i) = sValue then Return i
Next
Return -1

[/autoit] [autoit][/autoit] [autoit]

End Function
Function _ArraySearch_I(aArray() as Integer, sValue as Integer) As Integer
Dim As Integer i
for i = 0 to UBound(aArray) -1
if aArray(i) = sValue then Return i
Next
Return -1

[/autoit] [autoit][/autoit] [autoit]

End Function
Sub _ArrayUnique_S(aArray() as String)
'~ Dim As Integer i
'~ for i = 0 to UBound(aArray) -1
'~ if aArray(i) = sValue then Return i
'~ Next
'~ Return -1

[/autoit] [autoit][/autoit] [autoit]

End Sub
Sub _ArrayUnique_I(aArray() as Integer)
'~ Dim As Integer i
'~ for i = 0 to UBound(aArray) -1
'~ if aArray(i) = sValue then Return i
'~ Next
'~ Return -1

[/autoit] [autoit][/autoit] [autoit]

End Sub
Sub _ArrayDelete_S(aArray() as String, iIndex as Integer)
Dim As Integer _
i, _
iCount
Dim As String _
aNewArray(0 to UBound(aArray) -1)

[/autoit] [autoit][/autoit] [autoit]

for i = 0 to UBound(aArray) -1
aNewArray(i) = aArray(i)
Next

[/autoit] [autoit][/autoit] [autoit]

redim aArray(0 to UBound(aArray) -2)
for i = 0 to UBound(aArray) -1
if i <> iIndex then
aArray(iCount) = aNewArray(i)
iCount += 1
EndIf
Next

[/autoit] [autoit][/autoit] [autoit]

End Sub
Sub _ArrayDelete_I(aArray() as Integer, iIndex as Integer)
Dim As Integer _
i, _
iCount, _
aNewArray(0 to UBound(aArray) -1)

[/autoit] [autoit][/autoit] [autoit]

for i = 0 to UBound(aArray) -1
aNewArray(i) = aArray(i)
Next

[/autoit] [autoit][/autoit] [autoit]

redim aArray(0 to UBound(aArray) -2)
for i = 0 to UBound(aArray) -1
if i <> iIndex then
aArray(iCount) = aNewArray(i)
iCount += 1
EndIf
Next

[/autoit] [autoit][/autoit] [autoit]

End Sub
Sub _ArraySort(aArray() as String, iDimension as Integer = 0)
Dim as string _
aBackArray()
Dim as Integer _
i, _
j, _
aIntArray(), _
aTmpArray(Ubound(aArray)), _
iCount=-1, _
iArrayNr, _
iClear=-654321, _
iHoechste

[/autoit] [autoit][/autoit] [autoit]

' Int-Array erstellen
for i = 0 to ubound(aArray) -1
if aArray(i, 0) <> "" and aArray(i, 1) <> "" then
iCount += 1
redim preserve aIntArray(0 to iCount)
redim preserve aBackArray(0 to iCount, 0 to 1)
aIntArray(iCount) = valint(aArray(i, iDimension))
aBackArray(iCount, 0) = aArray(i, 0)
aBackArray(iCount, 1) = aArray(i, 1)
endif
next

[/autoit] [autoit][/autoit] [autoit]

' Int-Array sortieren (func __MySort)
for i = 0 to Ubound(aIntArray)-1
aTmpArray(i) = aIntArray(i)
next

[/autoit] [autoit][/autoit] [autoit]

for i = 0 to Ubound(aIntArray)-1
iHoechste = 0
for j = 0 to Ubound(aIntArray)-1
if aTmpArray(j) > iHoechste and aTmpArray(j) > iClear then
iHoechste = aTmpArray(j)
iArrayNr = j
EndIf
next
aIntArray(i) = iHoechste
aTmpArray(iArrayNr) = iClear
next

[/autoit] [autoit][/autoit] [autoit]

' aArray() wieder zusammenfügen
for i = 0 to ubound(aIntArray)-1
for j = 0 to ubound(aBackArray)-1
if aIntArray(i) = valint(aBackArray(j, iDimension)) then
aArray(i, 0) = aBackArray(j, 0)
aArray(i, 1) = aBackArray(j, 1)
aBackArray(j, 0) = ""
aBackArray(j, 1) = ""
continue for, for
EndIf
next
next

[/autoit] [autoit][/autoit] [autoit]

End Sub

[/autoit] [autoit][/autoit] [autoit]

' String Funktionen
Function StringLen(sString as String) As Integer
Return Len(sString)
End Function
Function StringLeft(sString as String, iLen As Integer) As String
Return Left(sString, iLen)
End Function
Function StringMid(sString as String, iStart As Integer, iLen As Integer) As String
Return Mid(sString, iStart, iLen)
End Function
Function StringRight(sString as String, iLen As Integer) As String
Return Right(sString, iLen)
End Function
Function StringTrimLeft(sString as String, iLen As Integer) As String
Return LTRIM(sString, Left(sString, iLen))
End Function
Function StringTrimRight(sString as String, iLen As Integer) As String
Return RTRIM(sString, Right(sString, iLen))
End Function

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit]

Ich habe auch alles fein in eine Datei gepackt, incl. der TSNE.
Vielleicht meldet sich ja jetzt jemand

Grüsse!

[Edit]
Die kompilierungsfehler welche angezeigt werden, stammen ALLE von der TSNE - nicht von den von mir erstellten Funktionen. Wenn ich verstehen würde wieso die alle angezeigt werden, und wie ich diese lösen kann - würde mich das auch weiterbringen...

tpm

Hi, .. ist zwar schon recht alter, der thread, aber ... hast du noch immer probleme mit tsne? .. wenn ja, welcher art von fehlermeldungen waren es denn? .. hast du dazu noch n output-log der compiling-fehler?

MfG
TPM