'*********************** '* COMPILER DIRECTIVES * '*********************** $ESCAPECHARS ON $TYPECHECK ON '$OPTIMIZE ON $INCLUDE $INCLUDE '**************************************** '* DECLARE SUBS/FUNCTIONS * '**************************************** DECLARE SUB getDataSetLabels DECLARE FUNCTION SetWindowLong Lib "user32" Alias "SetWindowLongA" (hwnd As Long, nIndex As Long, dwNewLong As Long) As Long '**************************************** '* PROGRAM CONSTANTS * '**************************************** CONST FTP_SERVER = "weather.noaa.gov" CONST FTP_LOGIN ="Anonymous" CONST FTP_PASSWORD = "john.davis253@verizon.net" CONST FTP_DIR1 = "data/observations/metar/stations/" '**************************************** '* GLOBAL VARIABLES * '**************************************** DIM FTP_FILE1 AS STRING DIM weatherFile AS QFILESTREAM DIM myFtp AS QFtpClient DIM Tmr AS QTimer DIM backGroundImage AS QIMAGE DIM form AS QFORM DIM tempLabel AS QLABEL DIM skyLabel AS QLABEL DIM windLabel AS QLABEL DIM station AS QLABEL DIM weatherLabel AS QLABEL DIM weatherImage AS QIMAGE DIM city AS QEDIT DIM changeCity AS QBUTTON DIM strTemperature AS STRING DIM strSky AS STRING DIM endSkyString AS INTEGER DIM startSkyString AS INTEGER DIM parsedSkyString AS STRING DIM strWind AS STRING DIM windStringMPH AS STRING DIM strMetar AS STRING DIM strStation AS STRING DIM deleteTime AS STRING DIM deleteLineFeed AS STRING DIM fileData AS STRING DIM Obj AS QOLEOBJECT Obj.CreateObject("MWeather.MetarDecoder") '**************************************** '* SUBS/FUNCTIONS * '**************************************** SUB getDataSetInfo Tmr.Enabled = 0 FTP_FILE1 = city.Text + ".TXT" IF city.Text = "" THEN SHOWMESSAGE "ERROR: PLEASE ENTER AN ICAO" ELSE IF myFtp.Connect (FTP_SERVER, FTP_LOGIN, FTP_PASSWORD) THEN IF myFtp.GetFile (FTP_DIR1 & FTP_FILE1, FTP_FILE1, True) THEN myFtp.GetFile (FTP_DIR1 & FTP_FILE1, FTP_FILE1, True) ELSE SHOWMESSAGE "ERROR: NO SUCH LOCATION. PLEASE TRY AGAIN" city.Text = "" END IF 'myFtp.GetFile (FTP_DIR2 & FTP_FILE2, FTP_FILE2, True) myFtp.Close ELSE SHOWMESSAGE "CONNECTION FAILED - Server not responding or no internet connection." application.Terminate END IF END IF weatherFile.Open(FTP_FILE1, fmOpenRead) fileData = weatherFile.ReadStr(weatherFile.Size) weatherFile.Position = 0 weatherFile.Close deleteTime = DELETE$(fileData, 1, 17) deleteLineFeed = DELETE$(deleteTime,1,1) strMetar = deleteLineFeed blnDecoded$ = Obj.DecodeMetarLine(strMetar) Obj.UnitTemperature = 12 Obj.UnitWinds = 34 strTemperature = Obj.GetWeatherData(6) strSky = Obj.GetWeatherData(12) strWind = Obj.GetWeatherData(9) strStation = Obj.GetWeatherData(1) DefStr WindString = strWind DefInt iLast = 0, iBegin, iEnd iBegin = Instr (iLast, WindString, "(") While iBegin <> 0 iEnd = Instr (iBegin, WindString, ")") WindString = Delete$(WindString, iBegin, iEnd - iBegin + 1) ' -1 if you want to keep the parenthesis iBegin = Instr (iBegin, WindString, "(") Wend windStringMPH = REPLACESUBSTR$(WindString,"mi/h","MPH") endSkyString = LEN(strSky) startSkyString = INSTR(strSky, " at ") parsedSkyString = DELETE$(strSky,startSkyString,endSkyString) IF Obj.GetWeatherData(13) <> "" THEN 'WEATHER LABEL weatherLabel.Parent = form weatherLabel.Caption ="Weather: " + Obj.GetWeatherData(13) weatherLabel.Height = 18 weatherLabel.Left = 85 weatherLabel.Top = 71 weatherLabel.Color = &h00F9F7F7 END IF IF Obj.GetWeatherIcon = 1 THEN IF VAL(LEFT$(LTRIM$(TIME$),INSTR(LTRIM$(TIME$),":")-1)) < 19 AND VAL(LEFT$(LTRIM$(TIME$),INSTR(LTRIM$(TIME$),":")-1)) > 06 THEN weatherImage.BMP = "resources\clear_small.bmp" ELSE weatherImage.BMP = "resources\clear_night_small.bmp" END IF ELSEIF Obj.GetWeatherIcon = 2 THEN IF VAL(LEFT$(LTRIM$(TIME$),INSTR(LTRIM$(TIME$),":")-1)) < 19 AND VAL(LEFT$(LTRIM$(TIME$),INSTR(LTRIM$(TIME$),":")-1)) > 06 THEN weatherImage.BMP = "resources\mostly_clear_small.bmp" ELSE weatherImage.BMP = "resources\mostly_clear_night_small.bmp" END IF ELSEIF Obj.GetWeatherIcon = 3 THEN IF VAL(LEFT$(LTRIM$(TIME$),INSTR(LTRIM$(TIME$),":")-1)) <= 19 AND VAL(LEFT$(LTRIM$(TIME$),INSTR(LTRIM$(TIME$),":")-1)) > 06 THEN weatherImage.BMP = "resources\partly_cloudy_small.bmp" ELSE weatherImage.BMP = "resources\partly_cloudy_night_small.bmp" END IF ELSEIF Obj.GetWeatherIcon = 4 THEN IF VAL(LEFT$(LTRIM$(TIME$),INSTR(LTRIM$(TIME$),":")-1)) <= 19 AND VAL(LEFT$(LTRIM$(TIME$),INSTR(LTRIM$(TIME$),":")-1)) > 06 THEN weatherImage.BMP = "resources\mostly_cloudy_small.bmp" ELSE weatherImage.BMP = "resources\mostly_cloudy_night_small.bmp" END IF ELSEIF Obj.GetWeatherIcon = 6 THEN weatherImage.BMP = "resources\overcast_small.bmp" ELSE weatherImage.BMP = "resources\NA_small.bmp" END IF tempLabel.Caption = "Temperature: " + strTemperature skyLabel.Caption = "Sky : " + parsedSkyString windLabel.Caption = "Wind: " + windStringMPH station.Caption = "Station: " + strStation KILL FTP_FILE1 Tmr.Enabled = 1 END SUB '**************************************** '* FORM CREATION * '**************************************** '*********** START FORM ************* form.Left = 158 form.Top = 122 form.Height = 157 form.Width = 225 form.BorderStyle = bsSingle form.Caption = " WeatherQ" form.Color = &h00E7E7E7 'form.OnShow = getDataSetLabels 'WEATHER IMAGE backGroundImage.Parent = form backGroundImage.Autosize = True backGroundImage.Top = 4 backGroundImage.Left = 0 backGroundImage.BMP = "resources\background.bmp" 'RES_WEATHER_IMAGE 'STATION LABEL station.Parent = form station.Caption="Station:" station.Left=10 station.Top=6 station.Color = &h00F9F7F7 'WEATHER IMAGE weatherImage.Parent = form weatherImage.Autosize = True weatherImage.Top = 24 weatherImage.Left = 7 weatherImage.BMP = "resources\NA_small.bmp" 'RES_WEATHER_IMAGE 'TEMPURATURE LABEL tempLabel.Parent = form tempLabel.Caption="Temperature:" tempLabel.Height=18 tempLabel.Left=85 tempLabel.Top=26 tempLabel.Color = &h00F9F7F7 'SKY LABEL skyLabel.Parent = form skyLabel.Caption ="Sky conditions:" skyLabel.Height = 18 skyLabel.Left = 85 skyLabel.Top = 41 skyLabel.Color = &h00F9F7F7 'WIND LABEL windLabel.Parent = form windLabel.Caption ="Wind:" windLabel.Height = 18 windLabel.Left = 85 windLabel.Top = 56 windLabel.Color = &h00F9F7F7 'CHANGE BUTTON changeCity.Parent = form changeCity.Caption = "Change Location" changeCity.Top = 98 changeCity.Left = 7 changeCity.Width = 100 changeCity.Height = 22 changeCity.Onclick = getDataSetInfo 'LOCATION TEXTBOX city.Parent = form city.Top = 98 city.Left = 162 city.Width = 50 'TIMER Tmr.Interval = 450000 Tmr.Enabled = 0 ' FALSE Tmr.OnTimer = getDataSetInfo '*********** END FORM ************* setwindowlong(form.handle, -8, 0) setwindowlong(application.handle, -8, form.handle) form.ShowModal