Übersetzungshilfe: VB6 -> PureBasic

Fragen zu allen anderen Programmiersprachen.
Benutzeravatar
Mok
BotHunter
Beiträge: 1484
Registriert: 26.12.2005 14:14
Computerausstattung: MSI GX780R
Intel Core i5-2410M
Nvidia GT 555M
Windows 7 Home Premium 64 bit
Wohnort:   

Übersetzungshilfe: VB6 -> PureBasic

Beitrag von Mok »

Hallo.
Da ich mit VisualBasic nichts am Hut habe, wollte ich mal fragen, ob jemand so nett sein könnte und imstande ist diesen Code für mich zu übersetzen?
Danke im voraus!

Gruß, Mok.
Win 7 Home Premium 64 bit | PureBasic 5.20 - x86 und x86-64 | Firefox [aktuelle stable-Version hier einfügen]
"Jeder macht irgendwann mal Fehler, darum gibt's auch Bleistifte mit Radiergummi." --Carl
Benutzeravatar
SoS
Beiträge: 340
Registriert: 29.08.2004 09:31
Kontaktdaten:

Re: Übersetzungshilfe: VB6 -> PureBasic

Beitrag von SoS »

Hab meinen 6 jahre alten Code noch gefunden. Must ihn Dir von PB 3.94 -> PB ? selbst anpassen.

MBMStarter.pbi

Code: Alles auswählen

; Source generiert durch DLL2PBLib
; Copyright 2005 by Thomas Schulz (TS-Soft)


; Globale Variablen deklaration
Global SendPath.l
Global SetPrio.l
Global Start.l
Global Stop.l

; Init-Funktion
ProcedureDLL MBMStarter_Init()
  Shared DLL.l
  DLL = LoadLibrary_("MBMStarter.dll")
  If DLL
    SendPath = GetProcAddress_(DLL, "SendPath")
    SetPrio = GetProcAddress_(DLL, "SetPrio")
    Start = GetProcAddress_(DLL, "Start")
    Stop = GetProcAddress_(DLL, "Stop")
    ProcedureReturn(#True)
  Else
    ProcedureReturn(#False)
  EndIf
EndProcedure
; End-Funktion
ProcedureDLL MBMStarter_End()
  Shared DLL.l
  FreeLibrary_(DLL)
EndProcedure
; Allgemeine Funktionen
ProcedureDLL.l SendPath()
  ProcedureReturn CallFunctionFast(SendPath)
EndProcedure

ProcedureDLL.l SetPrio(a.l)
  ProcedureReturn CallFunctionFast(SetPrio,a)
EndProcedure

ProcedureDLL.l Start()
  ProcedureReturn CallFunctionFast(Start)
EndProcedure

ProcedureDLL.l Stop()
  ProcedureReturn CallFunctionFast(Stop)
EndProcedure

Code: Alles auswählen

Procedure OnError() 
  Protected Msg$ 
  
  Msg$ = "There was an error:"+Chr(13)+Chr(10)+Chr(13)+Chr(10) 
  Msg$ + "Description: " + GetErrorDescription()+Chr(13)+Chr(10) 
  Msg$ + "Addr: " + Str(GetErrorAddress())+Chr(13)+Chr(10) 
  Msg$ + "Module: "+GetErrorModuleName()+Chr(13)+Chr(10) 
  Msg$ + "LineNR: " + Str(GetErrorLineNR())+Chr(13)+Chr(10) 
  Msg$ + "Total number of errors: "+Str(GetErrorCounter())+Chr(13)+Chr(10)+Chr(13)+Chr(10) 
  Msg$ + "Continue program ?" 
  SetClipboardText(Msg$) 
  
  If MessageRequester("Error!",Msg$,16|#PB_MessageRequester_YesNo) = 6 
    ProcedureReturn #True 
  Else 
    End 
  EndIf 
EndProcedure 

OnErrorGosub(@OnError())

#NrTemperature =32
#NrVoltage =16
#NrFan =16
#NrCPU =4


#ISA        = 0
#SMBus      = 1
#VIA686Bus  = 2
#DirectIO   = 3

#smtSMBIntel   =  0
#smtSMBAMD     =  1
#smtSMBALi     =  2
#smtSMBNForce  =  3
#smtSMBSIS     =  4
  
#stUnknown      = 0
#stTemperature  = 1
#stVoltage      = 2
#stFan          = 3
#stMhz          = 4
#stPercentage   = 5    

XIncludeFile "mbmstarter.pbi"

OpenConsole()
ConsoleTitle("Warte auf Daten")
ConsoleColor(14,1)
ClearConsole()

If MBMStarter_Init()=#False:MessageRequester("Error","Kann die MBMStarter.dll nicht finden/starten",#MB_ICONERROR):End:EndIf

Start()
  
Dim temperatures.l(#NrTemperature)
Dim temperaturesname.s(#NrTemperature)
Dim voltages.f(#NrVoltage)
Dim voltagesname.s(#NrVoltage)
Dim fans.l(#NrFan)
Dim fansname.s(#NrFan)


Structure SharedIndex
  iType.l;          // type of sensor
  count.l;          // number of sensor for that type
EndStructure

Structure SharedSensor
  ssType.b;                // type of sensor
  ssName.b[12];            // name of sensor
  sspadding1.b[3];         // padding of 3 byte
  ssCurrent.double ;       // current value
  ssLow.double ;           // lowest readout
  ssHigh.double ;          // highest readout
  ssCount.l;               // total number of readout
  sspadding2.b[4];         // padding of 4 byte
  ssTotal.b[10];   80 bit  // total amout of all readouts
  sspadding3.b[6];         // padding of 6 byte
  ssAlarm1.double ;        // temp & fan: high alarm; voltage: % off;
  ssAlarm2.double ;        // temp: low alarm
EndStructure
;Debug SizeOf(SharedSensor)
Structure SharedInfo
  siSMB_Base.w;         // SMBus base address
  siSMB_Type.b;         // SMBus/Isa bus used to access chip
  siSMB_Code.b;         // SMBus sub type, Intel, AMD or ALi
  siSMB_Addr.b;         // Address of sensor chip on SMBus
  siSMB_Name.b[41];     // Nice name for SMBus
  siISA_Base.w;         // ISA base address of sensor chip on ISA
  siChipType.l;         // Chip nr, connects with Chipinfo.ini
  siVoltageSubType.b;   // Subvoltage option selected
EndStructure

Structure SharedData
  sdVersion.double ;              // version number (example: 51090)
  sdIndex.SharedIndex [10];      // Sensor index
  sdSensor.SharedSensor [100];  // sensor info
  sdInfo.SharedInfo ;          // misc. info
  sdStart.b[41];              // start time
  sdCurrent.b[41];           // current time
  sdPath.b[256];            // MBM path
EndStructure
Debug "----Start-----"
Repeat
  ConsoleTitle("Warte auf Daten")
;  ConsoleColor(14,1)
;  ClearConsole()
  
*hSData=OpenFileMapping_(#FILE_MAP_READ, #False, "$M$B$M$5$S$D$")

If *hSData
  
  *ptr =MapViewOfFile_(*hSData, #FILE_MAP_READ, 0, 0, 0)
  
  ;Debug SizeOf(SharedData)
  RtlMoveMemory_(DS.SharedData,*ptr,SizeOf(SharedData))
  UnmapViewOfFile_(*ptr)
  CloseHandle_(*hSData)
  
  
  MBMVersion.s= "MBMVersion "+StrF(F64_toInt(DS\sdVersion)/10000)
  ;Debug "---------------------"
  
  totalCount = 0 
  For i = 0 To 4 
    tempCount = 0
    voltCount = 0
    fanCount = 0  
    totalCount = totalCount + DS\sdIndex[i]\count
    For j = 0 To totalCount
      Select  DS\sdSensor[j]\ssType 
        Case #stUnknown
        Case #stTemperature
          If F64_toFloat(DS\sdSensor[j]\ssCurrent) <> 255
            temperatures(tempCount) = F64_toInt(DS\sdSensor[j]\ssCurrent)
            name.s=""
            For na.b = 0 To 11
              name.s=name.s+Chr((DS\sdSensor[j]\ssName[na]))
            Next
            temperaturesname(tempCount)= name.s
            tempCount=tempCount+1
          EndIf
        Case #stVoltage
          If F64_toFloat(DS\sdSensor[j]\ssCurrent) <> 255 And F64_toFloat(DS\sdSensor[j]\ssCurrent) <> 0
            voltages(voltCount) = F64_toFloat(DS\sdSensor[j]\ssCurrent)
            name.s=""
            For na.b = 0 To 11
              name.s=name.s+Chr((DS\sdSensor[j]\ssName[na]))
            Next
            voltagesname(voltCount)= name.s
            voltCount=voltCount+1
          EndIf
        Case #stFan
          If F64_toInt(DS\sdSensor[j]\ssCurrent) <> 255 And F64_toInt(DS\sdSensor[j]\ssCurrent) >#False
            fans(fanCount) = F64_toInt(DS\sdSensor[j]\ssCurrent)
            name.s=""
            For na.b = 0 To 11
              name.s=name.s+Chr((DS\sdSensor[j]\ssName[na]))
            Next
            fansname(fanCount)= name.s
            fanCount=fanCount+1 
          EndIf
        Case #stMhz
          mbmcpuspeed.s= Str(F64_toInt(DS\sdSensor[j]\ssCurrent))+" mhz"
        Case #stPercentage
          ;Debug Str(F64_toInt(DS\sdSensor[j]\ssCurrent))
      EndSelect 
    Next 
  Next
Else
  CloseHandle_(*hSData)
  ;End ;  mbm läuft nicht
EndIf


x=1
y=0
ConsoleTitle("Daten werden ausgegeben")
ConsoleLocate(x, y):Print( "---------version---------")
y+1
ConsoleLocate(x, y):Print(MBMVersion.s)
y+1
ConsoleLocate(x, y):Print( "-------CPU-Speed---------")
y+1
ConsoleLocate(x, y):Print(mbmcpuspeed.s)
y+1
ConsoleLocate(x, y):Print( "---------temp------------")
For j = 0 To tempCount-1
  y+1
  ConsoleLocate(x, y):Print( temperaturesname(j)+"   "+Str(temperatures(j))+"ø"+"C" )
Next
y+1
ConsoleLocate(x, y):Print( "----------volt-----------")
For j = 0 To voltCount-1
  y+1
  ConsoleLocate(x, y):Print( voltagesname(j)+"   "+StrF(voltages(j))+" Volt")
Next
y+1
ConsoleLocate(x, y):Print( "----------fan-----------")
For j = 0 To fanCount-1
  y+1
  ConsoleLocate(x, y):Print( fansname(j)+"   "+Str(fans(j))+" U/min")
Next
ConsoleTitle("x zum beenden des Programms") 
Delay (100) 
Until Left(Inkey(), 1)="x"
Stop()
MBMStarter_End()
  
  
; IDE Options = PureBasic v3.94 (Windows - x86)
; CursorPosition = 19
; Folding = -
; EnableOnError
Antworten