Ich habe das ganze jetzt etwas umständlich (codeintensiv) aber dafür sehr genau arbeitend gelöst. Bitlänge und Modulationsfrequenz sind nun auch im Code-String enthalten. Ich kann so nun jeden IR Code von jeder Fernbedienung senden. Das ganze ist Teil meies Haussteuerungsprojektes. Ich kann nun von unterwegs Geräte daheim per Funk und IR Aussendung bedienen.

Da die wenigsten Fernbedienungen mit dem von Bascom unterstützten RC5 Protokoll funktionieren, kann dieser Code vielleicht auch für andere, die an ähnlichen Projekten arbeiten mal hilfreich sein.

Hier mein fertiger Code:

Code:
$regfile = "m8def.dat"
$crystal = 8000000
$hwstack = 200
$swstack = 200
$framesize = 200

Config Portb.1 = Output
Config Pinb.0 = Input
Taster Alias Pinb.0
Irled Alias Portb.1
Portb.0 = 1                                                 'pullup'

Dim Pwmwert As Word
Dim L As Byte
Dim H As Byte
Dim Code As String * 120 , Stellenzaehler As Byte , Bitwert_str As String * 1 , A As Byte , Bitlaenge As Word , Bitlaenge_str As String * 3
Dim Khz As Word , Khz_str As String * 3
L = 0
H = 1
Config Timer1 = Timer , Prescale = 1 , Compare A = Disconnect , Clear Timer = 1
Pwmwert = 104                                               ' 110=36khz, 104=38Khz, 99=40Khz (wert im code string enthalten)

Do
Debounce Taster , 0 , Sendecodeklimaanlage , Sub
Loop

Sendecodeklimaanlage:
Code = "386001111111111111110000000101010101010010101001001001001001010010010100101010101010100101001001001001001001"       'stelle 1-2 modulation in khz, stelle 3-5 bitlänge in us
Gosub Auswertung
Return

Satcodelauter:
Code = "3685011001100110101010011001011"                    'stelle 1-2 modulation in khz, stelle 3-5 bitlänge in us
Gosub Auswertung
Return

Fernseherleiser:
Code = "38600111111100000001001001001010101010100100100101010101010010010100101010101010100101001001001001"       'stelle 1-2 modulation in khz, stelle 3-5 bitlänge in us
Gosub Auswertung
Return

Auswertung:
Khz_str = Mid(code , 1 , 2)                                 'holt die modulationsfrequenz aus dem string (36,38 oder 40 Khz)
Khz = Val(khz_str)
Select Case Khz
Case 36
Pwmwert = 110
Case 38
Pwmwert = 104
Case 34
Pwmwert = 99
Case Else                                                   'wenn wert unbekannt dann 38 Khz
Pwmwert = 104
End Select
Compare1a = Pwmwert
Bitlaenge_str = Mid(code , 3 , 3)                           'holt die bitlänge aus dem string
Bitlaenge = Val(bitlaenge_str)
Stellenzaehler = Len(code) + 5
For A = 6 To Stellenzaehler                                 'von selle 6 weg die bits des sendecodes lesen und senden
Bitwert_str = Mid(code , A , 1)
Select Case Bitwert_str
Case "1"
Gosub Sendehigh
Case "0"
Gosub Sendelow
End Select
Next A
Config Timer1 = Timer , Prescale = 1 , Compare A = Disconnect , Clear Timer = 1       'am ende einer codeaussendung "disconnect" pwm damit die sendeled niemals an bleiben kann
Return

Sendehigh:
Config Timer1 = Timer , Prescale = 1 , Compare A = Toggle , Clear Timer = 1       'nur bei einem "high" die pulswellenausgabe aktivieren
Gosub Wartezeitbitlaenge                                    'variable wartezeit = bitlänge
Return

Sendelow:
Config Timer1 = Timer , Prescale = 1 , Compare A = Disconnect , Clear Timer = 1       'bei einem "low" erfolgt keine pwm ausgabe
Gosub Wartezeitbitlaenge                                    'variable wartezeit = bitlänge
Return

Wartezeitbitlaenge:                                         'waitus führt mit einer variablen zu starken abweichungen (auch mit 16Mhz takt), darum diese umständliche (aber genaue) lösung
Select Case Bitlaenge                                       'bitlänge: 850us technisat, 600us klimaanlage
Case 550
Waitus 550
Case 560
Waitus 560
Case 570
Waitus 570
Case 580
Waitus 580
Case 590
Waitus 590
Case 600
Waitus 600
Case 610
Waitus 610
Case 620
Waitus 620
Case 630
Waitus 630
Case 640
Waitus 640
Case 650
Waitus 650
Case 660
Waitus 660
Case 670
Waitus 670
Case 680
Waitus 680
Case 690
Waitus 690
Case 700
Waitus 700
Case 710
Waitus 710
Case 720
Waitus 720
Case 730
Waitus 730
Case 740
Waitus 740
Case 750
Waitus 750
Case 760
Waitus 760
Case 770
Waitus 770
Case 780
Waitus 780
Case 790
Waitus 790
Case 800
Waitus 800
Case 810
Waitus 810
Case 820
Waitus 820
Case 830
Waitus 830
Case 840
Waitus 840
Case 850
Waitus 850
Case 860
Waitus 860
Case 870
Waitus 870
Case 880
Waitus 880
Case 890
Waitus 890
Case 900
Waitus 900
Case 910
Waitus 910
Case 920
Waitus 920
Case 930
Waitus 930
Case 940
Waitus 940
Case 950
End Select
Return
 
End