fork download
copy 
  1. Function QS(RetVal)
  2.      Dim i As Long  
  3.         For i = 1 To Len(RetVal)
  4.             QS = QS + Val(Mid(RetVal, i, 1))
  5.         Next i
  6. End Function
  7.  
  8. Function OpCode()
  9.     Dim Date_ As String, d As String
  10.     Dim d_sum As Long
  11.     Dim N, E As String
  12.  
  13.         Date_ = Date  ' Datum des heutigen Tages i.d. Form "Tag.Monat.Jahr"
  14.  
  15.         Date_ = DateAdd("d", 28, Date_) ' zu Date_ 28 Tage addieren
  16.  
  17.         d_sum = Val(Left(Date_, 2) & Mid(Date_, 4, 2) & Right(Date_, 4))
  18.  
  19.         Do
  20.             d_sum = QS(d_sum)
  21.         Loop Until d_sum < 10
  22.  
  23.         d_sum = (d_sum * (&HA - 1)) + &HB0
  24.  
  25.         Do
  26.             d_sum = QS(d_sum)
  27.         Loop Until d_sum < 10
  28.  
  29.         N = "N53 30." + Right(Str((2 ^ &HA) - (6 * d_sum)), 3)
  30.         E = "E10 01." + Right(Str((111 * (2 + d_sum)) - &H28), 3)
  31.  
  32.         MsgBox "Die Koordinaten lauten " & N & " " & E
  33.  
  34. End Function
  35.  
  36.  
  37.  
  38.  
  39.         Date_ = Date  ' Datum des heutigen Tages i.d. Form "Tag.Monat.Jahr"
  40.  
  41.  
  42.  
  43.         Date_ = DateAdd("d", 28, Date_) ' zu Date_ 28 Tage addieren
  44.  
  45.  
  46.  
  47.         d_sum = Val(Left(Date_, 2) & Mid(Date_, 4, 2) & Right(Date_, 4))
  48.  
  49.  
  50.  
  51.         Do
  52.  
  53.             d_sum = QS(d_sum)
  54.  
  55.         Loop Until d_sum < 10
  56.  
  57.  
  58.  
  59.         d_sum = (d_sum * (&HA - 1)) + &HB0
  60.  
  61.  
  62.  
  63.         Do
  64.  
  65.             d_sum = QS(d_sum)
  66.  
  67.         Loop Until d_sum < 10
  68.  
  69.  
  70.  
  71.         N = "N53 30." + Right(Str((2 ^ &HA) - (6 * d_sum)), 3)
  72.  
  73.         E = "E10 01." + Right(Str((111 * (2 + d_sum)) - &H28), 3)
  74.  
  75.  
  76.  
  77.         MsgBox "Die Koordinaten lauten " & N & " " & E
  78.  
  79.  
  80.  
  81. End Function
  82.  
  83.  
  84.  
  85.  
Success #stdin #stdout 0.02s 25416KB
comments (?)
stdin
copy 
Function QS(RetVal)
     Dim i As Long  
        For i = 1 To Len(RetVal)
            QS = QS + Val(Mid(RetVal, i, 1))
        Next i
End Function

Function OpCode()
    Dim Date_ As String, d As String
    Dim d_sum As Long
    Dim N, E As String
    
    27.04.2009 = Date  ' Datum des heutigen Tages i.d. Form "Tag.Monat.Jahr"
      
        Date_ = DateAdd("d", 28, Date_) ' zu Date_ 28 Tage addieren
        
        d_sum = Val(Left(Date_, 2) & Mid(Date_, 4, 2) & Right(Date_, 4))
        
        Do
            d_sum = QS(d_sum)
        Loop Until d_sum < 10
        
        d_sum = (d_sum * (&HA - 1)) + &HB0
        
        Do
            d_sum = QS(d_sum)
        Loop Until d_sum < 10
        
        N = "N53 30." + Right(Str((2 ^ &HA) - (6 * d_sum)), 3)
        E = "E10 01." + Right(Str((111 * (2 + d_sum)) - &H28), 3)
        
        MsgBox "Die Koordinaten lauten " & N & " " & E

End Function
stdout
copy 
Function QS(RetVal)
     Dim i As Long  
        For i = 1 To Len(RetVal)
            QS = QS + Val(Mid(RetVal, i, 1))
        Next i
End Function

Function OpCode()
    Dim Date_ As String, d As String
    Dim d_sum As Long
    Dim N, E As String
    
        Date_ = Date  ' Datum des heutigen Tages i.d. Form "Tag.Monat.Jahr"
      
        Date_ = DateAdd("d", 28, Date_) ' zu Date_ 28 Tage addieren
        
        d_sum = Val(Left(Date_, 2) & Mid(Date_, 4, 2) & Right(Date_, 4))
        
        Do
            d_sum = QS(d_sum)
        Loop Until d_sum < 10
        
        d_sum = (d_sum * (&HA - 1)) + &HB0
        
        Do
            d_sum = QS(d_sum)
        Loop Until d_sum < 10
        
        N = "N53 30." + Right(Str((2 ^ &HA) - (6 * d_sum)), 3)
        E = "E10 01." + Right(Str((111 * (2 + d_sum)) - &H28), 3)
        
        MsgBox "Die Koordinaten lauten " & N & " " & E

End Function


    

        Date_ = Date  ' Datum des heutigen Tages i.d. Form "Tag.Monat.Jahr"

      

        Date_ = DateAdd("d", 28, Date_) ' zu Date_ 28 Tage addieren

        

        d_sum = Val(Left(Date_, 2) & Mid(Date_, 4, 2) & Right(Date_, 4))

        

        Do

            d_sum = QS(d_sum)

        Loop Until d_sum < 10

        

        d_sum = (d_sum * (&HA - 1)) + &HB0

        

        Do

            d_sum = QS(d_sum)

        Loop Until d_sum < 10

        

        N = "N53 30." + Right(Str((2 ^ &HA) - (6 * d_sum)), 3)

        E = "E10 01." + Right(Str((111 * (2 + d_sum)) - &H28), 3)

        

        MsgBox "Die Koordinaten lauten " & N & " " & E



End Function
https://ideone.com/xXdjPx
language:
PHP (php 7.3.5)
created:
15 hours ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!