向表

时间:2016-06-03 18:56:18

标签: delphi

在循环访问我的客户表并根据地址发布纬度和经度值时,第一组lat / lng值将发布到记录编号1和2,然后随后每个记录都会关闭一个。当我在调试模式中单步执行时,我看到第一个记录的值在我的第二次迭代中仍然存在。之后,它会自行更正,但每个记录值都是针对其上方的地址或记录。为什么呢?

这是我的代码:

procedure TViewMaps.StartBtnClick(Sender: TObject);
var
  iRecs, i : Integer;
  Location : TLocation;
begin
  ViewMaps := TViewMaps.create(self, MapAddress);
  Customer.Open;
  iRecs:= Customer.RecordCount;
  i := 0;
  While Not Customer.EOF do
    begin
      i := i + 1;
      Customer.Edit;
      MapAddress := CustomerSAddress1.AsString + ' ' + CustomerSAddress2.AsString + ' ' + CustomerSAddress3.AsString + ' ' + CustomerSAddress4.AsString + ', ' + CustomerSCity.AsString + ', ' + CustomerSState.AsString + ' ' + CustomerSZip.AsString;

      fAddress := StringReplace(StringReplace(Trim(MapAddress), #13, ' ', [rfReplaceAll]), #10, ' ', [rfReplaceAll]);
      Location := GetGeoCode(fAddress);

      Customerlat.AsString := Location.Lat;
      Customerlng.AsString := Location.Lng;

      StatusBar1.SimpleText:= 'Update Geocode for address ' + ' [Count ' + IntToStr(i) + ' of ' + IntToStr(iRecs) + ']';
      Sleep(3000);
      StatusBar1.Refresh;
      Customer.Next;
    end;
end;

好的,我根据你的建议修改了代码(不确定我是否采用了正确的方式),但我得到了完全相同的结果。这个程序只是一个运行一次的应用程序,用于将lat / lng值填充到我们的数据库,延迟是因为我遇到了Google查询限制,应用程序在结果从Google返回之前发布到数据库,所以我不得不放慢速度。

这是更新后的代码:

procedure TViewMaps.StartBtnClick(Sender: TObject);
begin
  Customer.Open;
  iRecCount:= Customer.RecordCount;
  iCurRec := 0;
  Customer.First;
  if Not Customer.EOF then Timer1.Enabled := True;
end;

procedure TViewMaps.OnTimer(Sender: TObject);
begin
  iCurRec := iCurRec + 1;
  //ShowMessage('I am here and iCurRec = ' + inttostr(iCurRec));
  Customer.Edit;
  // Load full customer address into MapAddress
  MapAddress := CustomerSAddress1.AsString + ' ' + CustomerSAddress2.AsString + ' ' + CustomerSAddress3.AsString + ' ' + CustomerSAddress4.AsString + ', ' + CustomerSCity.AsString + ', ' + CustomerSState.AsString + ' ' + CustomerSZip.AsString;
  fAddress := StringReplace(StringReplace(Trim(MapAddress), #13, ' ', [rfReplaceAll]), #10, ' ', [rfReplaceAll]);
  // Get Longitude and Latitude from Google Maps
  Location := GetGeoCode(fAddress);
  // Populate lat and lng fields in Customer table
  Customerlat.AsString := Location.Lat;
  Customerlng.AsString := Location.Lng;
  // Post record to Customer table
  Customer.Post;
  StatusBar1.SimpleText:= 'Update Geocode for address ' + ' [Count ' + IntToStr(iCurRec) + ' of ' + IntToStr(iRecCount) + ']';
  StatusBar1.Refresh;
  // Grab the next record in the Customer table
  Customer.Next;
  if Customer.EOF then Timer1.Enabled := False;
end;

好的......这里是codeAddress javascript

''+
'  function codeAddress(address) { '+
'    if (geocoder) {'+
'      geocoder.geocode( { address: address}, function(results, status) { '+
'        if (status == google.maps.GeocoderStatus.OK) {'+
'          map.setCenter(results[0].geometry.location);'+
'          var myLatlng = new google.maps.LatLng( results[0].geometry.location.lat(), results[0].geometry.location.lng()); '+
'          var marker = new google.maps.Marker({ '+
'            position: myLatlng, '+
'            title: "", '+
'            map: map '+
'          }); '+
'        markersArray.push(marker); '+
'        document.getElementById("hiddenlat").value = myLatlng.lat(); '+
'        document.getElementById("hiddenlng").value = myLatlng.lng(); '+
' '+
'        } else {'+
'            document.getElementById("hiddenlat").value = "error"; '+
'            document.getElementById("hiddenlng").value = "error"; '+
'           alert("Geocode was not successful for the following reason: " +    status);'+
'        }'+
'      });'+
'    }'+
'  }'+
''+

以下是Delphi代码:

constructor TViewMaps.create(AOwner: TComponent; AAddress: string);
begin
  inherited create(AOwner);
  fAddress := AAddress; // fAddress is now stored to form variable
end;

procedure TViewMaps.LoadGoogleApi;
var
  aStream: TMemoryStream;
begin
  WebBrowser1.Navigate('about:blank'); //Set the location to an empty page
  MemoAddress.Lines.Text := '1600 Amphitheatre Parkway, Mountain View, CA 94043';
  if Assigned(WebBrowser1.Document) then
  begin
    aStream := TMemoryStream.Create; //create a TStream to load the Page from the string
    try
      aStream.WriteBuffer(Pointer(HTMLStr)^, Length(HTMLStr));
      aStream.Seek(0, soFromBeginning);
      (WebBrowser1.Document as IPersistStreamInit).Load(TStreamAdapter.Create(aStream));
    finally
      aStream.Free;
    end;
    HTMLWindow2 := (WebBrowser1.Document as IHTMLDocument2).parentWindow;
  end;

  while WebBrowser1.ReadyState <> READYSTATE_COMPLETE do // wait for google
  begin
    sleep(0);
    application.processmessages;
  end;
end;

function TViewMaps.GoogleApiReady: boolean;
begin
  result := (HTMLWindow2 <> nil);
end;

procedure TViewMaps.ExecuteScript(AScript: string);
begin
  HTMLWindow2.execScript(AScript, 'JavaScript');
end;

function TViewMaps.GetElementByID(AElementID: string): IHTMLElement;
begin
  result := (WebBrowser1.Document as IHTMLDocument3).getElementByID(AElementID);
end;

function TViewMaps.GetElementValue(ElementID: string): string;
var
  HtmlElement: IHTMLElement;
begin
  HtmlElement := GetElementByID(ElementID);
  result := HtmlElement.getAttribute('value', 0);
end;

procedure RemoveInvalidGeoLookupChars(var AString: string);
begin
  AString := StringReplace(StringReplace(Trim(AString), #13, ' ', [rfReplaceAll]), #10, ' ', [rfReplaceAll]);
  // remove invalid chars
  AString := StringReplace(AString, #39, #32, [rfReplaceAll]);  // single quotes
  AString := StringReplace(AString, #34, #32, [rfReplaceAll]);  // double quotes
end;

procedure TViewMaps.FormShow(Sender: TObject);
var
  Location: TLocation;
begin
  MapAddress := '1600 Amphitheatre Parkway' + ', ' + 'Mountain View' + ', ' + 'CA' + ' ' + '94043';
  ViewMaps := TViewMaps.create(self, MapAddress);
  LoadGoogleApi;
  address := MemoAddress.Lines.Text;
  fAddress := StringReplace(StringReplace(Trim(address), #13, ' ', [rfReplaceAll]), #10, ' ', [rfReplaceAll]);
  Location := GetGeoCode(fAddress);
  LatitudeEdit.Text := Location.Lat;
  LongitudeEdit.Text := Location.Lng;
end;

function TViewMaps.GetGeocode(Address: string): TLocation;
begin
  result.Lat := '0';
  result.Lng := '0';
  LatitudeEdit.text := '0';
  LongitudeEdit.text := '0';
  result.Result := 'OK';
  application.processmessages;
  RemoveInvalidGeoLookupChars(address);
  application.processmessages;
  ExecuteScript(Format('codeAddress(%s)',[QuotedStr(Address)]));

  while (GetElementValue('hiddenlat') = '0') do
    application.processmessages;

  result.Lat := GetElementValue('hiddenlat');
  result.Lng := GetElementValue('hiddenlng');
end;

procedure TViewMaps.StartBtnClick(Sender: TObject);
var
  iRecCount, iCurRec: integer;
  Location: TLocation;
  fAddress, MapAddress: string;
begin
    Customer.open;
    Customer.first;
    iRecCount := Customer.RecordCount;
    iCurRec := 0;
    while not Customer.eof do
    begin
      inc(iCurRec);
      fillchar(Location, sizeof(Location), 0);
      MapAddress := CustomerSAddress1.asstring+' '+CustomerSAddress2.asstring+' '+CustomerSCity.asstring+', '+CustomerSState.asstring+' '+CustomerSZip.asstring;
      fAddress := StringReplace(StringReplace(Trim(MapAddress), #13, ' ', [rfReplaceAll]), #10, ' ', [rfReplaceAll]);
      fillchar(Location, sizeof(Location), 0);
      Location := GetGeocode(fAddress);
      if (Location.lat <> 'error') and (Location.lat <> '0') then
      begin
        Customer.edit;
        CustomerLat.AsString := Location.Lat;
        CustomerLng.AsString := Location.Lng;
        Customer.Post;
      end;
      Statusbar1.SimpleText := 'Update Geocode for address ' + ' [Count ' + IntToStr(iCurRec) + ' of ' + IntToStr(iRecCount) + ']';
      application.processmessages;
      sleep(2000); // adjust to not exceed Google API query limit
      Customer.next;
    end;
end;

2 个答案:

答案 0 :(得分:1)

不确定你的循环在哪里进行这些观察,但是在最初在q中的代码中,在您调用Customer.Next之前,对当前记录的更改将不会发布,这将在移动之前发布任何更改表格光标到下一条记录。但是你不应该依赖这种行为,特别是因为你只是在延迟后调用Customer.Next。

请改为尝试:

  Customerlng.AsString := Location.Lng;
  Customer.Post;

如果事实证明你所遇到的问题是由于你说你必须引入以避免过于频繁地调用GetGeoLocation而导致的延迟造成的问题,我不会感到惊讶。一种消除原因的方法是使用原始循环的测试版本,无任何延迟(Sleep())和一个替换GetGeoCode例程,每次调用它时只返回一些唯一值。这个替换GetGeoCode例程可以在每次调用时简单地递增记录的LatLng成员,并返回更新的记录。

这个简化的测试版本应该可以正常工作。如果它没有,你的代码必须做一些你没有告诉我们的事情,只有你可以调试它。另一方面,如果 正常工作,您需要提出一种避免过于频繁地调用真实GetGeoCode的更好方法。特别是它不应该

a)在你应用程序的主要gui线程中调用Sleep(),这就是你在q的原始版本中所做的事情;和

b)尝试完全在OnClick处理程序中执行。

如果你真的必须引入延迟,请执行类似

的操作
  • 将TTimer添加到表单中,延迟时间为3000或其他任何内容。

  • 在StartBtnClick中,只需致电Customer.First,检查Customer.Eof,如果错误,请激活tttimer。然后退出。

  • 在其OnTimer中,更新当前的客户记录,调用Customer.Post,刷新状态栏,调用Customer.Next,检查Customer.Eof并在Eof为真时取消ttimer以使其OnTimer赢得&再次打电话。

你应该保护你的OnTimer免于重入(即在完成执行之前再次调用OnTimer)。在表单上有一个布尔标志UpdateExecuting,测试它在进入OnTimer时是否为真,如果是,则立即退出,否则将其设置为true,然后在finally部分将其设置为false您的OnTimer的其余部分中try .. finally。或者,您可以在输入OnTimer事件时禁用TTimer,并在finally部分重新启用它。

如果您不想使用TTimer,您可以在Application.OnIdle处理程序中执行我为其OnTimer所建议的内容。

最重要的是在后台线程中进行更新,但是在gui线程中将更新检索到Customer实例是多么容易取决于您的Customer表是什么类型的TDataSet。

顺便说一下:您的客户表没有使用包含Customerlat或Customerlng的索引吗?

另外顺便说一下:你的q不包含正确的MCVE,这是这种类型的问题应该包含的内容,因为没有一个,读者无法重现问题。如果没有一个,我认为它可能会吸引投票结束。

答案 1 :(得分:1)

SO的用户应该知道这是OP以前的一个问题的延续 - Getting Latitude Longitude from GoogleMaps in TWebBrowser

我使用下面的代码创建了一个测试。我的客户表字段名称不同,但您可以理解。

请注意尽可能缩短Customer.edit和Customer.post之间的时间,以避免任何过早的帖子。此外,请确保Customer表没有任何可能导致循环中断的事件。仅在返回有效地理编码时编辑/发布。为了更好地衡量,每次迭代都会初始化位置记录。

procedure TForm2.StartBtnClick(Sender: TObject);
var
  iRecCount,
  iCurRec: integer;
  Location: TLocation;
  fAddress, MapAddress: string;
begin
    Customer.open;
    Customer.first;
    iRecCount := Customer.RecordCount;
    iCurRec := 0;
    while not Customer.eof do
    begin
      inc(iCurRec);
      fillchar(Location, sizeof(Location), 0);
      MapAddress := CustomerAddress.asstring+' '+CustomerAddress2.asstring+' '+CustomerCity.asstring+', '+CustomerState.asstring+' '+CustomerZip.asstring;
      fAddress := StringReplace(StringReplace(Trim(MapAddress), #13, ' ', [rfReplaceAll]), #10, ' ', [rfReplaceAll]);
      fillchar(Location, sizeof(Location), 0);
      Location := form1.GetGeocode(fAddress);
      if (Location.lat <> 'error') and (Location.lat <> '0') then
      begin
        Customer.edit;
        CustomerLatitude.AsString := Location.Lat;
        CustomerLongitude.AsString := Location.Lng;
        Customer.Post;
      end;
      Statusbar1.SimpleText := 'Update Geocode for address ' + ' [Count ' + IntToStr(iCurRec) + ' of ' + IntToStr(iRecCount) + ']';
      application.processmessages;
      sleep(1000); // adjust to not exceed Google API query limit
      Customer.next;
    end;
end;   

另外,修改codeAddress Javascript函数以清除隐藏的页面值。

''+
'  function codeAddress(address) { '+
'    document.getElementById("hiddenlat").value = "0"; '+
'    document.getElementById("hiddenlng").value = "0"; '+
'    if (geocoder) {'+
'      geocoder.geocode( { address: address}, function(results, status) { '+
'        if (status == google.maps.GeocoderStatus.OK) {'+
'          map.setCenter(results[0].geometry.location);'+
'          var myLatlng = new google.maps.LatLng( results[0].geometry.location.lat(), results[0].geometry.location.lng()); '+
'          var marker = new google.maps.Marker({ '+
'            position: myLatlng, '+
'            title: "", '+
'            map: map '+
'          }); '+
'        markersArray.push(marker); '+
'        document.getElementById("hiddenlat").value = myLatlng.lat(); '+
'        document.getElementById("hiddenlng").value = myLatlng.lng(); '+
' '+
'        } else {'+
'            document.getElementById("hiddenlat").value = "error"; '+
'            document.getElementById("hiddenlng").value = "error"; '+
'           alert("Geocode was not successful for the following reason: " +    status);'+
'        }'+
'      });'+
'    }'+
'  }'+
''+