Hej,

mina kunskaper och läroböcker omfattar endast TurboPascal 5.5 och ej nyare versioner.
Har fått programkod sm jag måste översätta till VB6. Är det någon som kan hjälpa mig ?
Dessa funktioner skall ligga i samma modul som de anropas ifrån.

mvh
Håkan

Unit Pack50;

{Denne Unit packer/udpacker en nummerisk string i 50 tals system}

INTERFACE

FUNCTION DoPack50(InPack : STRING) : String;
FUNCTION DoUnPack50(InUnPack : STRING) : String;

IMPLEMENTATION

CONST
PackChars : STRING[50] = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ!@#œ-$%_()«&{}';


FUNCTION REALDiv(A, B: REAL) : REAL;
BEGIN
REALDiv := INT(A/B);
END;


FUNCTION ToREAL(InString : STRING) : REAL;
VAR
OK : BOOLEAN;
Count : INTEGER;
TmpResult : REAL;
BEGIN
OK := TRUE;
Count := 1;
TmpResult := 0.0;
While (Count <=Length(Instring)) AND OK DO
BEGIN
IF InString[Count] in ['0'..'9'] THEN
BEGIN
TmpResult := TmpResult * 10 + (ORD(InString[Count])-$30);
END
ELSE
BEGIN
OK := FALSE;
END;
INC(Count);
END;
IF OK THEN
BEGIN
ToREAL := TmpResult;
END
ELSE
BEGIN
ToREAL := 0.0;
END;
END;

FUNCTION PackNBr(Nbr : REAL ; Cifre : INTEGER) : STRING;
VAR
Rest, Count : INTEGER;
TmpResult : STRING;

FUNCTION GetRest(A, B : REAL) : INTEGER;
VAR
C : REAL;
BEGIN
C := REALDiv(A,B);
GetRest := Round(A-C*B);
END;

BEGIN
TmpResult := '';
FOR Count := 1 TO CIFRE DO
BEGIN
Rest := GetRest(Nbr, 50);
Nbr := REALDiv(Nbr,50);
TmpResult := PackChars[Rest+1] + TmpResult;
END;
PackNBr := TmpResult;
END;

FUNCTION UnPackNbr(InString : STRING) : REAL;
VAR
Count : INTEGER;
P : LONGINT;
OK : BOOLEAN;
TmpResult : REAL;

BEGIN
TmpResult := 0.0;
OK := TRUE;
Count := 1;
WHILE (Count <= Length(InString)) AND OK DO
BEGIN
P := Pos(InString[Count], PackChars)-1;
IF P >= 0 THEN
BEGIN
TmpResult :=(TmpResult*50)+P;
END
ELSE
BEGIN
OK := FALSE;
END;
INC(Count);
END;
IF OK THEN
UnPackNbr := TmpResult
ELSE
UnPackNBr := -1;
END;

FUNCTION DoPack50(InPack : STRING) : String;
BEGIN
DoPack50 := PackNbr(ToREAL(InPAck),8);
END;

FUNCTION DoUnPack50(InUnPack : STRING) : String;
VAR
TmpResult : STRING;
BEGIN
TmpResult := '';
STR(UnPackNbr(InUnPack):1:0,TmpResult);
DoUnpack50 := TmpResult;
END;


BEGIN
END.

Det ser enkelt ut.Jag tar det gärna som terapi.
Du får vänta någon dag eller två.

Gott Nyttår alla Vb och Delphi vänner Vb.net nissarna hoppas jag
tänker till och får ett Gott C++ år ;-)

Borttaget se slutversion

Ett tips som tåls att upprepas.

För många år sedan lade jag upp mitt program "VbToDelphi" här hos pelle.

Jag hittar det inte längre, men ! kör Google "VbTo Delphi" så hittar Ni en hel del.

Fö älskar jag Delphi för att det är så lätt att lära för oss gamla Vb-freeks.

Förresten vad betyder Google ???

Ahaaa kom på det nu, Ord = ordinal och betyder var det sökta tecknet står i strängen.

Samma som Vb:s InStr.

Iom. det tycker jag att Delphikoden är "klumpig och dum"

Inget större proffs som skrivit den.

Vad skall den egentligen göra ?

"Förresten vad betyder Google ???"


Hmm betyder väl inget men man kan ju anta att det kommer från matematiska termen "googol"

Se mer:
http://mathforum.org/library/drmath/view/57575.html

Delphi = Pseudokod = ej äkta kod :)

Jag kan inte påstå att jag vet svaret men "googles" är väl ett slanguttryck för glasögon? Google borde väl då bli något i stil med granska, sök, leta.

/Janne

Hej,

det är en kod som räknar om i ngt som kallas 50-talssystem. Vi skall skicka in order till ett
system som endast klarar av filnamn med 8+3 tecken vissa referenser som endast är 8 tecken.
Via denna kod skall vi kunna konvertera långa filnamn, som består av siffror, och långa referenser
till 50-tals system. Jag försöker att klura ut hur det skall fungera och när jag nu fått hjälp på
traven så kanske jag löser det. Tack för hjälpen.
Håkan

Oki på det.

Håkan !
Här har du tappat bort en del kodrader.

Edit: Fel av mig det var rätt.

Om Gud är god så skall denna översättning funka.
<b>Detta lägger du i en Form1 tex.</b>
<code>
Option Explicit

Private Sub Command1_Click()
MsgBox DoPack50("din teststräng här")
End Sub

Private Sub Command2_Click()
MsgBox DoUnPack50("din teststräng här")
End Sub

Private Function DoPack50(ByVal InPack As String) As String
DoPack50 = PackNBr(ToReal(InPack), 8)
End Function

Private Function DoUnPack50(ByVal InUnPack As String) As String
Dim tmpRes As String
tmpRes = CStr(UnPackNbr(InUnPack))
DoUnPack50 = tmpRes
End Function
</code>
<b> I en basModul </b>
<code>
Option Explicit
Public Const PACK_CHARS = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ!@#œ-$%_()«&{}"

Public Function RealDiv(ByVal A As Double, ByVal B As Double) As Double
RealDiv = A \ B 'Heltalsdivision
End Function

Public Function ToReal(ByVal strIn As String) As Double
Dim Ok As Boolean, count As Long, tmpRes As Double
Ok = True
count = 1
tmpRes = 0
Do While count <= Len(strIn) And Ok = True
If IsNumeric(Mid$(strIn, count, 1)) Then
'Hex 30 = 48 dec
tmpRes = tmpRes * 10 + Asc(Mid$(strIn, count, 1)) - 48
Else
Ok = False
End If
count = count + 1
If Ok Then
ToReal = tmpRes
Else
ToReal = 0
End If
Loop
End Function

Public Function GetRest(ByVal A As Double, ByVal B As Double) As Long
Dim C As Double
C = RealDiv(A, B)
GetRest = Int(A - C * B)
End Function

Public Function PackNBr(ByVal Nbr As Double, ByVal Cifre As Long) As String
Dim rest As Long, count As Long, tmpRes As String
tmpRes = ""
For count = 1 To Cifre
rest = GetRest(Nbr, 50)
Nbr = RealDiv(Nbr, 50)
tmpRes = Mid$(PACK_CHARS, rest + 1) & tmpRes
Next 'count
PackNBr = tmpRes
End Function

Public Function UnPackNbr(ByVal strIn As String) As Double
Dim count As Long, P As Long, Ok As Boolean, tmpRes As Double
tmpRes = 0
Ok = True
count = 1
Do While count <= Len(strIn) And Ok = True
P = InStr(PACK_CHARS, Mid$(strIn, count)) - 1
If P >= 0 Then
tmpRes = tmpRes * 50 + P
Else
Ok = False
End If
count = count + 1
Loop
If Ok = True Then
UnPackNbr = tmpRes
Else
UnPackNbr = -1
End If
End Function
</code>

Har testat VB koden lite,ser att det finns lite debugging att göra.

Skulle vara bra att få ett exempel på en riktig lösning.

Dvs en UnPack och en Pack att skicka till vårt test VB.

Nu har jag fått igång Delphiprojectet.
Dvs facit.

Om jag kan få ett riktigt värde att skicka till UnPack resp Pack
så kan jag trimma VB koden att göra likadant.

Nu får jag -1 och 00000 Varför vet jag inte kör din Pascalkod rakt upp och ner.

Men det är väl som gammalt känt "skit in skit ut"

När jag nu provkör VB koden får jag detta svar på <b>DoPack50</b> funktionen.

<b>0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ!@#œ-$%_()«&{}
0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ!@#œ-$%_()«&{}
0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ!@#œ-$%_()«&{}
BCDEFGHIJKLMNOPQRSTUVWXYZ!@#œ-$%_()«&{}@#œ-$%_()«
&{}œ-$%_()«&{}456789ABCDEFGHIJKLMNOPQRSTUVWXYZ!@#œ
-$%_()«&{}NOPQRSTUVWXYZ!@#œ-$%_()«&{}</b>

Är jag på rätt väg ?

Hej,

jag har fått denna ledtråd 885 i 50-tal-system är 000000HZ.


mvh
Håkan

Guld nu löser Vi det.

"Heureka" Det blir det hos mig med.

Återkommer inom kort på denna kanal med en korrekt Vblösning

Skicka ett mail till <b>svenpon@telia.com</b> så skall du till att börja med få en
fungerande Delphi .exe med bifogad källkod.

Delphi C++ mfl är underbara.

Jag behöver inte skicka med en massa Ms "shit" för att det skall funka.

Jag skickar en .exe så "Voila" funkar det.

Länge leve "Stand Alone" programmering. VB är en katastrof på just detta.
Annars är det kanon vad gäller lätt att designa mm. mm.
Kanonbra nybörjarprogrammering.

Kanske det finns fler som är intresserade
så jag lägger upp den på Programarkivet en stund.

Jag tar bort den om någon vecka.

Programarkivet:920

DS

<b>Delphi = Pseudokod = ej äkta kod :)</b>
<b> LOL</b>
Ytterligare ett intelligen inlägg från "mupparna" på läktaren .

Do_Pack50.exe (Delphi) är nu uppdaterad,
så man kan bara kan slå in siffror och versaler där det skall vara.
Programarkivet:920
DS

Såååååååååååååååååååånt djä..... strul om man skall ändra i Pelles
Programarkiv, mitt lilla "skötebarn"

Jag ville uppdater mitt Delphiprojekt . Det sket sig.

Phuuuuuuu......

Håller tråden vid liv

Programarkivet:Ny DoPack50_UnPack50